如何在有多个列共享相同值的情况下将行合并在一起？

Question

我必须在 Excel 中将信息与 VBA 一起分组，如果 Big Group 列和 Sub Group 列中有任何重复值，则这些行将合并为一行。

这就是表格的样子：

|Big Group|Sub Group| Animals
------------------------------
| A1      | a       | raccoon     
------------------------------
| B2      | b       | dog
------------------------------
| B2      | c       | tiger
------------------------------
| B2      | c       | lion
------------------------------
| A1      | d       | deer
------------------------------
| A1      | a       | bear
------------------------------

我想将这些行组合成这样：

|Big Group|Sub Group| Animals
-----------------------------------
| A1      | a       | raccoon; bear
-----------------------------------
| B2      | b       | dog
-----------------------------------
| B2      | c       | tiger; lion
-----------------------------------
| A1      | d       | deer
-----------------------------------

我尝试过使用这个宏代码。它有效，但我唯一的问题是它只在它们彼此相邻的情况下合并行：

Sub combi()
Dim i As Long
lastRow = 7

For i = lastRow To 2 Step -1
    If Cells(i, 2).Value = Cells(i - 1, 2).Value Then
        Cells(i - 1, 3).Value = Cells(i - 1, 3).Value & ";" & Cells(i, 3).Value
        Rows(i).Delete
    End If
Next i
End Sub 

Here is the table output with the macro above. 有人可以建议我改进这个宏的方法吗？

谢谢你，
鲁迪

Answer 1

要运行您尝试的合并代码类型，必须根据匹配条件对数据进行排序。

Option Explicit

Sub combi()
    Dim i As Long, lastRow  As Long

    lastRow = 7

    With Range(Cells(2, "A"), Cells(lastRow, "C"))
        .Sort key1:=.Cells(1, 1), order1:=xlAscending, _
              key2:=.Cells(1, 2), order2:=xlAscending, _
              Header:=xlNo
    End With

    For i = lastRow - 1 To 2 Step -1
        If Cells(i, "A").Value = Cells(i + 1, "A").Value And _
           Cells(i, "B").Value = Cells(i + 1, "B").Value Then
            Cells(i, "C").Value = Join(Array(Cells(i, "C").Value, Cells(i + 1, 3).Value), ";")
            Rows(i + 1).Delete
        End If
    Next i
End Sub

如果出于某种原因您试图避免对数据进行排序，则必须使用比单行偏移更远的比较方法。