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

我正在编写一个macros，它将用于整合来自一系列单元格的数据。 我在表D2中列出了我要合并到表格（“1”）中的数据：J6，并且目的地位置在M2：R2（列表M到R，但是它们包含标题）。 我已经写了下面的代码的一部分，适用于他们并运行。 然而，即使它没有说它有错误，它只是不会正常运行..我是从我的Excel中运行macros后的屏幕截图。

从图像中可以看到，我想合并D行中的重复值，并打印位于与列D中的合并值相同的行中的列E，F，G，H，I，J中的值的平均值。例如，对于列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范围内，并且输出必须从Row 2 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 

这段代码将给出以下结果。