Как объединить строки, где есть более одного столбца, которые имеют одинаковое значение?

Question

Я должен сгруппировать информацию вместе с VBA в Excel, где, если в есть столбцы большой группы и столбца подгруппы , если есть какие-либо повторяющиеся значения, строки будут объединены в одну строку.

Вот как выглядит таблица:

|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 

Вот вывод таблицы с макросом выше. Кто-нибудь может мне предложить способ улучшить этот макрос?

Спасибо,
Roody

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

Если по какой-то причине вы пытаетесь избежать сортировки данных, то следует использовать метод сравнения, который выглядит дальше, чем смещение на одну строку.