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得到其余行的平均值，所以我会得到一些看起来像的东西：

 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

溶液 我最终创建了一个我将逐渐使用Union扩展的范围，如下所示：

  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

使用数据透视表很容易。

这是最终结果的图片。