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()

我现在要做的是将基于名称的数据合并到新工作表或Excel文件中。输出表应该类似于

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

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

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

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合并来自多行

1 个答案: