excel以编程方式合并列z中具有相同值的所有行

Question

我正在运行dataimport宏，并且想要合并数据集中列x中具有相同值的所有行，然后我希望获得一行代表组x [y] x的平均值是列，y是该特定分组的列x的值。

是否有一个简单的功能来做到这一点，还是我必须创建一个大量的备用循环的广泛循环？

明晰化： 所以我的数据集看起来像

A | B  | C 
1   2   4 
1   2   5 
2   7   3 
2   5   1 
3   2   1 
1   5   6 

现在我要合并的列列的值，因此，所有A的同等价值得到他们行的其余部分均所以我会得到事端看起来像：

A | B  | C 
1   3   5 
2   6   2 
3   2   1 

到目前为止，我一直在试图遍历A列的可能值（1〜10）手动此功能，但它总是崩溃Excel和我想不通为什么，我的某处必定有一个无限循环在这个函数：

Function MergeRows(sheet, column, value) 
Dim LastRow 
Dim LastCol 
Dim numRowsMerged 
Dim totalValue 

numRowsMerged = 1 
LastRow = sheet.UsedRange.Rows.Count 
LastCol = sheet.UsedRange.Columns.Count 
With Application.WorksheetFunction 
    For iRow = LastRow - 1 To 1 Step -1 
     'enter loop if the cell value matches what we're trying to merge 
     Do While Cells(iRow, column) = value 
       For iCol = 1 To LastCol 
       'skip the column that we're going to use as merging value, and skip the column if it contains 3 (ikke relevant) 
       If Not (iCol = column) And Not (Cells(iRow, iCol) = 3) Then 
        Cells(iRow, iCol) = (Cells(iRow, iCol) * numRowsMerged + Cells(iRow + 1, iCol))/(numRowsMerged + 1) 
       End If 
       Next iCol 
      'delete the row merged 
      Rows(iRow + 1).Delete 
     Loop 

     'add one to the total number of rows merged 
     numRowsMerged = numRowsMerged + 1 
    Next iRow 
End With 

End Function 

解决方案 我结束了创建，我将逐步推广使用联盟的范围，就像这样：

Function GetRowRange(sheet, column, value) As range 
Dim LastRow 
Dim LastCol 
Dim numRowsMerged 
Dim totalValue 
Dim rowRng As range 
Dim tempRng As range 
Dim sheetRange As range 

numRowsMerged = 1 
Set sheetRange = sheet.UsedRange 
LastRow = sheet.UsedRange.Rows.Count 
LastCol = sheet.UsedRange.Columns.Count 
With Application.WorksheetFunction 
    For iRow = 1 To LastRow Step 1 
     'enter loop if the cell value matches what we're trying to merge 
     If (sheetRange.Cells(iRow, column) = value) Then 
      Set tempRng = range(sheetRange.Cells(iRow, 1), sheetRange.Cells(iRow, LastCol)) 
      If (rowRng Is Nothing) Then 
       Set rowRng = tempRng 
      Else 
       Set rowRng = Union(rowRng, tempRng) 
      End If 
     End If 

     'add one to the total number of rows merged 
     numRowsMerged = numRowsMerged + 1 
    Next iRow 
End With 
Set GetRowRange = rowRng 
End Function 

Answer 1

这是你正在尝试？既然你想要VBA代码，我没有使用Pivots，但使用了一个更简单的选项; formulas来计算你的平均值。

Option Explicit 

Sub Sample() 
    Dim col As New Collection 
    Dim wsI As Worksheet, wsO As Worksheet 
    Dim wsIlRow As Long, wsOlRow As Long, r As Long, i As Long 
    Dim itm 

    '~~> Chnage this to the relevant sheets 
    Set wsI = ThisWorkbook.Sheets("Sheet1") 
    Set wsO = ThisWorkbook.Sheets("Sheet2") 

    '~~> Work with the input sheet 
    With wsI 
     wsIlRow = .Range("A" & .Rows.Count).End(xlUp).Row 
     '~~> get unique values from Col A 
     For i = 1 To wsIlRow 
      On Error Resume Next 
      col.Add .Range("A" & i).Value, """" & .Range("A" & i).Value & """" 
      On Error GoTo 0 
     Next i 
    End With 

    r = 1 

    '~~> Write unique values to Col A 
    With wsO 
     For Each itm In col 
      .Cells(r, 1).Value = itm 
      r = r + 1 
     Next 

     wsOlRow = .Range("A" & .Rows.Count).End(xlUp).Row 

     '~~> Use a simple formula to find the average 
     For i = 1 To wsOlRow 
      .Range("B" & i).Value = Application.Evaluate("=AVERAGE(IF(" & wsI.Name & _ 
            "!A1:A" & wsIlRow & "=" & .Range("A" & i).Value & _ 
            "," & wsI.Name & "!B1:B" & wsIlRow & "))") 

      .Range("C" & i).Value = Application.Evaluate("=AVERAGE(IF(" & wsI.Name & _ 
            "!A1:A" & wsIlRow & "=" & .Range("A" & i).Value & _ 
            "," & wsI.Name & "!C1:C" & wsIlRow & "))") 
     Next i 
    End With 
End Sub 

SCREENSHOT

Answer 2

这是很容易使用数据透视表。

下面是最终结果的图片。