Объединить данные из двух разных таблиц и сформировать новую таблицу в Excel

Question

У меня есть две таблицы, как показано ниже:

table1              |  table2
------------------  |  ------------------
Customer    Group   |  Customer Product
------------------  |  ------------------
A           x       |  A         alpha
B           y       |  B         gamma 
A           y       |  C         alpha
C           x       |  A         gamma

Я пытаюсь написать код vba для формирования таблицы, как показано ниже;

Final Table
---------------------------
Customer   Group   Product
---------------------------
A          x       alpha
A          x       gamma
A          y       alpha
A          y       gamma
B          y       gamma
C          x       alpha

Объяснение таково:

1. Сначала мы получаем вхождения каждого клиента в обеих таблицах и определяем, сколько строк будет в итоговой таблице.Пример: A повторяется 2 раза в таблице 1 и 2 раза в таблице 2, поэтому в итоговой таблице будет 4 строки a
2. Во-вторых, мы должны повторить каждую группу с уникальными значениями продукта.Пример: A имеет две группы x, y из таблицы 1, а A имеет альфа и гамму.Таким образом, мы бы получили A и повторили x с альфа и повторили x с гаммой ....

Вот код, который я разрабатывал ....

У меня была первая таблицав листе с именем table1 и второй таблице в листе с именем table3.С помощью следующего я смог достичь только двух столбцов конечного результата!

Sub Test()

    Sheets("table3").Range("B3", Sheets("table3").Range("B3").End(xlDown)).Copy Destination:=Sheets("table3").Range("E2")
    Sheets("table3").Range("E2", Sheets("table3").Range("E2").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
    Customer_Count = Range("E2").End(xlDown).Row - 1
    'MsgBox Customer_Count
    Dim Unique_Customers(), Sales_Count(), Group_Count() As Variant
    ReDim Unique_Customers(1 To Customer_Count)
    ReDim Sales_Count(0 To Customer_Count)
    ReDim Group_Count(0 To Customer_Count)
    n = 10

    For i = 1 To 2 'Customer_Count
        'Unique_Customers(i) = Cells(i + 1, 5).Value
        'Unique_Customers_Data = Unique_Customers_Data & " - " & Cells(i + 1, 5).Value

        Sales_Count(i) = Application.WorksheetFunction.CountIf(Sheets("table3").Range("B3", Sheets("table3").Range("B3").End(xlDown)), Sheets("table3").Cells(i + 1, 5))
        Group_Count(i) = Application.WorksheetFunction.CountIf(Sheets("table1").Range("B3", Sheets("table1").Range("B3").End(xlDown)), Sheets("table3").Cells(i + 1, 5))
        'MsgBox "Group_Count: " & Group_Count & vbCr & "Sales_Count: " & Sales_Count
        For j = 1 To Sales_Count(i) * Group_Count(i)
            Sheets("Final").Cells(9 + j + k, 2).Value = Sheets("table3").Cells(i + 1, 5).Value
        Next
        k = k + (Sales_Count(i) * Group_Count(i))

        For l = 1 To Group_Count(i)
            For m = 1 To Sales_Count(i)
                Sheets("Final").Cells(n, 3).Value = Sheets("table1").Cells(l + 2 + Group_Count(i - 1), 3).Value
                MsgBox (l & "---->" & Sheets("table1").Cells(l + 2 + Group_Count(i - 1), 3).Value)
                n = n + 1
            Next
        Next
    Next
End Sub

Любая помощь по заполнению или лучшее решение очень ценится!

Answer 1

Я приведу небольшой пример и позволю вам поработать с ним - просто нужно пройтись по каждой таблице (кто знает, где они находятся) и посмотреть, есть ли у вас совпадение с клиентом, а затем добавить строки в новыйтаблица:

Option Explicit
Sub Test()

Dim i As Long, j As Long, k As Long
Dim customer As String, group As String, product As String

j = 2

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    customer = Cells(i, 1).Value
    group = Cells(i, 2).Value

    For k = 2 To Cells(Rows.Count, 4).End(xlUp).Row
        product = Cells(k, 5).Value

        If Cells(k, 4).Value = customer Then
            Cells(j, 7).Value = customer
            Cells(j, 8).Value = group
            Cells(j, 9).Value = product

            j = j + 1
        End If
    Next k
Next i

'Sort A to Z
ActiveSheet.Sort.SortFields.Add Key:=Range("G2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveSheet.Sort.SetRange Range("G2:I" & Cells(Rows.Count, 7).End(xlUp).Row)
ActiveSheet.Sort.Apply

End Sub