Excel VBA 合并多行数据

Question

我有一个相当大的 XLS，信息分布在多行中，如下所示：

TopName   Name   Mode   Item1   Item2   Item3   Item4
-----------------------------------------------------
Foo       Name1  ModeX  x()
Foo       Name2  ModeY                  x()
Foo       Name1  ModeX                  y() 
Foo       Name1  ModeX                          y()
Foo       Name2  ModeY  y()

我现在要做的是根据名称将数据合并到一个新的sheet或Excel文件中。输出 table 应该类似于

Name   Mode   Item1   Item2   Item3   Item4
-------------------------------------------
Name1  ModeX  x()             y()     y()
Name2  ModeY  y()             x()

我自己会尝试通过 VBA 提出一个解决方案，但肯定有人在这方面做得更好，也许可以 post 一个简单的解决方案？

更新：我尝试了以下但它根本不起作用：

Sub ConsolidateRows()
'takes rows and consolidate one or many cells, based on one or many cells matching with above or below rows.

Dim lastRow As Long, i As Long, j As Long
Dim colMatch As Variant, colConcat As Variant

'**********PARAMETERS TO UPDATE****************
Const strMatch As String = "B"    'columns that need to match for consolidation, separated by commas
Const strConcat As String = "C,D,F,H,I,J,K,L,M,N,O,P,Q,R,S,T,U"     'columns that need consolidating, separated by commas
Const strSep As String = ", "     'string that will separate the consolidated values
'*************END PARAMETERS*******************

Application.ScreenUpdating = False 'disable ScreenUpdating to avoid screen flashes

colMatch = Split(strMatch, ",")
colConcat = Split(strConcat, ",")

lastRow = Range("B" & Rows.Count).End(xlUp).Row 'get last row

For i = lastRow To 4 Step -1 'loop from last Row to one

    For j = 0 To UBound(colMatch)
        If Cells(i, colMatch(j)) &#x3c;&#x3e; Cells(i - 1, colMatch(j)) Then GoTo nxti
    Next

    For j = 0 To UBound(colConcat)
        Cells(i - 1, colConcat(j)) = Cells(i - 1, colConcat(j)) & strSep & Cells(i, colConcat(j))
    Next

    Rows(i).Delete

nxti:
Next

Application.ScreenUpdating = True 'reenable ScreenUpdating
End Sub

Update2: 好的，该文件在连续的行中甚至没有两个匹配值，因此，上面的代码显然不能工作:(我需要的是某种字典或其他东西...

Answer 1

与您的任务和示例相关Excel 工作表数据如下所示：

TopName Name    Mode    Item1   Item2   Item3   Item4

Foo     Name1   ModeX   x()         
Foo     Name2   ModeY                    x()    
Foo     Name1   ModeX                    y()    
Foo     Name1   ModeX                          y()
Foo     Name2   ModeY   y()

您可以使用以下 Excel VBA 代码段：

Sub ConsolidateRowsData()
Dim lastRow As Long, i As Long, j As Long, k As Long

Application.ScreenUpdating = False 'disable ScreenUpdating

lastRow = Range("B" & Rows.Count).End(xlUp).Row 'get last row

'concatenate Item data
For i = 3 To lastRow  'outer loop thru data rows (starting w/row 3)
    For j = i + 1 To lastRow 'inner loop thru data rows
        If Cells(i, 2) = Cells(j, 2) Then
            For k = 4 To 7 'loop thru columns: Item1...Item4
                If (Cells(i, k) = "" And Cells(j, k) <> "") Then
                    Cells(i, k) = Cells(j, k)
                End If
            Next
        End If
    Next
Next

'delete duplicates
For i = 3 To lastRow   'outer loop thru data rows
    For j = lastRow To i + 1 Step -1 'inner loop thru data rows
        If Cells(i, 2) = Cells(j, 2) Then
            Rows(j).Delete
        End If
    Next
Next

Application.ScreenUpdating = True 'reenable ScreenUpdating
End Sub

即使它没有针对速度进行优化，但也能胜任。希望这会有所帮助。最好的问候，

Excel VBA 合并多行数据

Excel VBA to merge data from multiple rows

excel

vba

rows

cells