Vba 合并来自两个不同表的数据，并在excel中形成一个新表

我有两张表，如下所示

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

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

我正在尝试编写一个vba代码，以形成如下表

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

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

原因是,

首先，我们获取两个表中每个客户的出现次数，并确定它在最终表中有多少行。例：A在表1中重复了2次，在表2中重复了2次，所以在最后一个表中将有4行A

第二，我们应该重复每一组具有独特价值的产品。例：A有两组x，y来自表1，A有α和γ。所以我们有A，用α重复x，用γ重复x

这是我正在开发的代码

我在表1中有第一个表，在表3中有第二个表。有了下面的内容，我只能获得最终结果的两列

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

---

非常感谢您对完成或提供更好解决方案的任何帮助

我将给你一个小例子，让你来处理它-只需循环遍历每个表（谁知道它们在哪里？），看看是否有客户匹配，然后将行添加到新表中：

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

---

您似乎可以使用透视表“我正在尝试编写vba代码”。我看不到您的代码。@Marcucciboy2如果所有表都是相同格式且具有相同列，则引用有一个解决方案。但这里我有一个不同的要求。无论如何，谢谢你提出建议！：）真是太棒了@d讽刺你的逻辑简单而优雅！工作得很有魅力。我的想法太复杂了！谢谢！：）