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

Question

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

正如你可以从图像看到的，我想巩固D行中的重复值并打印位于与列D中的合并值相同的行中位于列E，F，G，H，I，J中的值的平均值。例如，对于列D中的值“Gebze 6832” ，我想将其作为副本删除，并将其设置为目标中的一个单元格，并从在目标列中合并的两行中打印列E，F，G，H，I，J的平均值。

我的代码如下（UPDATE）

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 

此代码将给出以下结果。