合并数据并提供合并数据的平均值

Question

我正在编写一个宏，用于合并一系列单元格中的数据。我有 table 和我想在范围 D2:J6 中的 sheets("1") 中合并的数据，目标位置再次在 M2:R2 中的 sheets("1") 中（ M 到 R 列，但它们包含 headers) 。我已经写了下面的一部分代码，适用于他们运行s。然而，即使它没有说它有错误，它只是不会运行正确..我在宏运行s ..[=11= 之后提供我的 excel 的截图]

正如您从图中看到的那样，我想合并 D 行中的重复值，并在与D 列中的合并值。例如，对于 D 列中的值 "Gebze 6832"，我想将其作为重复项删除，使其成为目标中的一个单元格并打印 E、F、G、H 列的平均值, I , J 来自在目标列中合并到它旁边的两行。

我的代码如下（更新）

Dim ws As Worksheet
Dim dataRng As Range
Dim dic As Variant, arr As Variant
Dim cnt As Long
Set ws = Sheets("1")
With ws
lastrow = .Cells(.Rows.Count, "D").End(xlUp).Row    'get last row in Column D
Set dataRng = .Range("D2:D" & lastrow)              'range for Column D
Set dic = CreateObject("Scripting.Dictionary")
arr = dataRng.Value
For i = 1 To UBound(arr)
dic(arr(i, 1)) = dic(arr(i, 1)) + 1
Next
.Range("M2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys)   'uniques data from Column D
.Range("Q2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.items)
cnt = dic.Count
For i = 2 To cnt + 1
.Range("N" & i & ":P" & i).Formula = "=SUMIF($D:$D$" & lastrow & ",$M" & i & ",E:E$" & lastrow & ")/" & dic(.Range("M" & i).Value)
.Range("R" & i).Formula = "=IF(INDEX($I:$I$" & lastrow & ",MATCH($M" & i & ",$D:$D$" & lastrow & ",0))=0,N" & i & ","""")"
.Range("S" & i).Formula = "=IF(INDEX($I:$I$" & lastrow & ",MATCH($M" & i & ",$D:$D$" & lastrow & ",0))=0,Q" & i & ","""")"
.Range("T" & i).Formula = "=IF($S" & i & ">0,SUMPRODUCT(($D:$D$" & lastrow & "=$M" & i & ")*(($J:$J$" & lastrow & "-$E:$E$" & lastrow & ")>3%)),"""")"
Next i
.Range("M" & i).Value = "Grand Total"
.Range("N" & i & ":P" & i).Formula = "=AVERAGE(N2:N" & cnt + 1 & ")"
.Range("Q" & i).Formula = "=SUM(Q2:Q" & cnt + 1 & ")"
.Range("R" & i).Formula = "=AVERAGE(R2:R" & cnt + 1 & ")"
.Range("S" & i & ":T" & i).Formula = "=SUM(S2:S" & cnt + 1 & ")"
.Range("N2:T" & .Cells(.Rows.Count, "M").End(xlUp).Row + 1).Value = .Range("N2:T" & .Cells(.Rows.Count, "M").End(xlUp).Row + 1).Value
End With

Answer 1

假设您的数据在从 Row 2 开始的 Column D to Column J 范围内并且输出必须从 Row 2 开始的 Column M to Column S 显示以下内容可能会有所帮助。

Sub Demo()
    Dim ws As Worksheet
    Dim dataRng As Range
    Dim dic As Variant, arr As Variant
    Dim cnt As Long

    Set ws = ThisWorkbook.Sheets("Sheet4")  'change Sheet4 to your data sheet

    Application.ScreenUpdating = False
    With ws
        lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row    'get last row in Column D
        Set dataRng = .Range("D2:D" & lastRow)              'range for Column D
        Set dic = CreateObject("Scripting.Dictionary")
        arr = dataRng.Value

        For i = 1 To UBound(arr)
            dic(arr(i, 1)) = dic(arr(i, 1)) + 1
        Next
        .Range("M2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys)   'uniques data from Column D
        cnt = dic.Count
        For i = 2 To cnt + 1
            .Range("N" & i & ":S" & i).Formula = "=SUMIF($D:$D$" & lastRow & ",$M" & i & ",E:E$" & lastRow & ")/" & dic(.Range("M" & i).Value)
        Next i
        .Range("N2:S" & .Cells(.Rows.Count, "M").End(xlUp).Row).Value = .Range("N2:S" & .Cells(.Rows.Count, "M").End(xlUp).Row).Value
    End With
    Application.ScreenUpdating = True
End Sub

此代码将给出以下结果。

合并数据并提供合并数据的平均值

Consolidate data and provide average of the consolidated data

excel

vba

consolidation