Excel 合并两个表中的数据

Question

我有两组数据，A 和 B，如下所示。

我想要做的是将数据 A 和 B 合并以生成数据 C。

有没有办法实现自动化，而不是手动复制和粘贴？

由于实际数据非常庞大，最好的解决方案是什么？

Answer 1

在模块中尝试此代码并链接到页面上的按钮，它假定您的 IP 地址在 A 中，策略在 C 中，描述在 D 中。输出转到 F、G 和 H 列。

Sub matrix()

Application.ScreenUpdating = False
Dim ws1 As Worksheet: Set ws1 = Sheet1
Dim MyIPRnge As Range, MyPRnge As Range, MyDRnge As Range
Dim MyX As String
Dim MyArr() As Variant
Dim i As Long, x As Long, y As Long, MyCols As Long

Set MyIPRnge = ws1.Range(ws1.Cells(2, 1), ws1.Cells(ws1.Cells(2, 1).End(xlDown).Row, 1))
Set MyPRnge = ws1.Range(ws1.Cells(2, 3), ws1.Cells(ws1.Cells(2, 3).End(xlDown).Row, 3))
Set MyDRnge = ws1.Range(ws1.Cells(2, 4), ws1.Cells(ws1.Cells(2, 4).End(xlDown).Row, 4))
MyCols = ws1.Cells(2, 3).End(xlToRight).Column - 2 ' the two assumes it is in column 3 to start with, modify to 1 less than start col
ReDim MyArr(MyIPRnge.Rows.Count * MyPRnge.Rows.Count)
x = 1
For i = LBound(MyArr) To UBound(MyArr) - 1
    MyArr(i) = MyPRnge(x, 1)
    If x = MyPRnge.Rows.Count Then
    x = 1
    Else
    x = x + 1
    End If
Next i
ws1.Range(ws1.Cells(2, 7), ws1.Cells((MyIPRnge.Rows.Count * MyPRnge.Rows.Count) + 1, 8)) = Application.Transpose(MyArr)
x = 1
For i = LBound(MyArr) To UBound(MyArr) - 1
    MyArr(i) = MyDRnge(x, 1)
    If x = MyDRnge.Rows.Count Then
    x = 1
    Else
    x = x + 1
    End If
Next i
ws1.Range(ws1.Cells(2, 8), ws1.Cells((MyIPRnge.Rows.Count * MyPRnge.Rows.Count) + 1, 8)) = Application.Transpose(MyArr)
ReDim MyArr(MyIPRnge.Rows.Count)
MyArr = MyIPRnge.Value2
y = 1
For i = 1 To UBound(MyArr) * MyPRnge.Rows.Count Step UBound(MyArr)
    For x = 1 To UBound(MyArr)
        ws1.Range(ws1.Cells(x + i, 6), ws1.Cells(UBound(MyArr) + i, 6)) = MyArr(y, 1)
    Next x
    y = y + 1
Next i

End Sub

Answer 2

看起来你想把来自的Data B每一行的数据结合起来Data A

下面的代码假设：

• 数据 A 是一个Table命名Sheet1数据DataA，并且只有一列。
• 数据 B 是一个Table命名数据Sheet1，DataB可以有多个列。
• 输出将在同一张工作表上，但您可以轻松更改代码以将其放在其他地方。

如果数据不在表中，您可以轻松使用不同的算法来找到它们。

由于代码在 VBA 数组、字典和集合中完成“工作”，如果您的数据很大，那么与从工作表读取/写入相比，您应该会看到明显的速度差异。

如果向表中添加更多行，或者向表中添加更多列，代码应该会自动调整DataB

Option Explicit
Sub combineTables()
    Dim loA As ListObject, loB As ListObject
    Dim dataA As Variant, dataB As Variant
    Dim ws As Worksheet
    Dim I As Long, J As Long, K As Long, V, W, X
    Dim myD As Dictionary, Col As Collection
    Dim sKey As String

    Dim vRes As Variant, wsRes As Worksheet, rRes As Range

'Read the data into variant arrays for processing speed
Set ws = ThisWorkbook.Worksheets("Sheet1") 'or whatever

Set loA = ws.ListObjects("DataA")
Set loB = ws.ListObjects("DataB")

dataA = loA.DataBodyRange
dataB = loB.DataBodyRange

'Write the combinations into a dictionary to organize it
Set myD = New Dictionary

For I = 1 To UBound(dataA)
    Set Col = New Collection
    sKey = dataA(I, 1)
    myD.Add Key:=sKey, Item:=Col
        For J = 1 To UBound(dataB)
            ReDim V(1 To UBound(dataB, 2))
            For K = 1 To UBound(V)
                V(K) = dataB(J, K)
            Next K
            myD(sKey).Add V
        Next J
Next I

'Output the results into an array
ReDim vRes(0 To UBound(dataA) * UBound(dataB), 1 To UBound(dataA, 2) + UBound(dataB, 2))

vRes(0, 1) = "IP"

For J = 1 To loB.HeaderRowRange.Columns.Count
    vRes(0, J + 1) = loB.HeaderRowRange.Columns(J).Value
Next J

I = 0
For Each V In myD.Keys
    For Each W In myD(V)
        J = 1
        I = I + 1
        vRes(I, J) = V
        For Each X In W
            J = J + 1
            vRes(I, J) = X
        Next X
    Next W
Next V

'write to the worksheet
Set wsRes = ws
Set rRes = wsRes.Cells(1, 10)
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))

With rRes
    .EntireColumn.Clear
    .Value = vRes
    .Style = "Output"
    .EntireColumn.AutoFit
End With

End Sub