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

Question

我正在编写一个宏，它将用于合并来自一系列单元格的数据。我有一个表，其中包含我想要合并到范围D2:J6中的表(“1”)中的数据，目标位置也在M2:R2中的表(“1”)中(列M到R，但它们包含标题)。我已经编写了下面代码的一部分，它适用于它们并为它们运行。然而，即使它没有说有错误，它也不会正确运行。在宏运行后，我提供了我的excel中的屏幕截图。

正如您从图像中看到的，我希望合并D行中的重复值，并将E、F、G、H、I、J列中的值的平均值打印到与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$2:$D$" & lastrow & ",$M" & i & ",E$2:E$" & lastrow & ")/" & dic(.Range("M" & i).Value)
.Range("R" & i).Formula = "=IF(INDEX($I$2:$I$" & lastrow & ",MATCH($M" & i & ",$D$2:$D$" & lastrow & ",0))=0,N" & i & ","""")"
.Range("S" & i).Formula = "=IF(INDEX($I$2:$I$" & lastrow & ",MATCH($M" & i & ",$D$2:$D$" & lastrow & ",0))=0,Q" & i & ","""")"
.Range("T" & i).Formula = "=IF($S" & i & ">0,SUMPRODUCT(($D$2:$D$" & lastrow & "=$M" & i & ")*(($J$2:$J$" & lastrow & "-$E$2:$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范围内，并且输出必须从Column M to Column S从Row 2显示，下面的内容可能会有所帮助。

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$2:$D$" & lastRow & ",$M" & i & ",E$2: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

此代码将产生以下结果。

​

​