arrays - VBA 比较 2 个数组并返回缺失的行，包括重复项

问题描述

每天早上我都必须手动逐行比较我数据库中的信息与经纪人发送的信息。通常它们应该具有完全相同的信息。这些信息是关于已执行交易的。

1- 我需要逐行比较，查看值"Stock"、"Qty"、"Price" 和 "Date"。如果任何行彼此不匹配（即其中一个表中的值错误地不同或整行丢失），我需要将不匹配的行打印在第三个“OUTPUT”表中。

我的桌子，经纪人的桌子和输出

2-这里的问题是，像“microsoft”或“nvidia”这样的重复项是独立的行业（不同的 ID）。在比较中必须保留重复项，因为它们是不同的交易。

我该如何管理重复问题？在字典中使用集合可以帮助我吗？我会将 A 表与 B 表进行比较，然后将 B 表与 A 表进行比较。或者重复的存在（实际上是独立交易）使其无法执行？

我的文件有 500 多行。

标签： arraysexcelvbamultidimensional-array

首先，请阅读 DS_London 的评论。

如果你想要一个结果表，那么你可以使用下面的宏：

Option Explicit

Sub CompareData()
    Dim wbk As Workbook
    Dim wshMyData As Worksheet, wshBrokersData As Worksheet, wshResult As Worksheet
    Dim i As Integer, j As Integer, k As Integer
    Dim sTmp As String
    
    On Error Resume Next
    Set wbk = ThisWorkbook
    Set wshResult = wbk.Worksheets("Result")
    
    On Error GoTo Err_CompareData

    'if there_s no result sheet
    If Not wshResult Is Nothing Then
        Application.DisplayAlerts = False
        wbk.Worksheets("Result").Delete
        Application.DisplayAlerts = True
    End If
    
    Set wshMyData = wbk.Worksheets("Sheet1")
    Set wshBrokersData = wbk.Worksheets("Sheet2")
    Set wshResult = wbk.Worksheets.Add(After:=wshBrokersData)
    wshResult.Name = "Result"
    wshResult.Range("A1") = "ID"
    wshResult.Range("B1") = "Stock"
    wshResult.Range("C1") = "Qty"
    wshResult.Range("D1") = "Price"
    wshResult.Range("E1") = "Date"
    wshResult.Range("F1") = "My"
    wshResult.Range("G1") = "Broker"
    wshResult.Range("A1:G1").Interior.Color = vbGreen
    
    'find last entry in your data
    i = wshMyData.Range("A" & wshMyData.Rows.Count).End(xlUp).Row
    'find last entry in brokers data
    j = wshBrokersData.Range("A" & wshBrokersData.Rows.Count).End(xlUp).Row
    'copy data into result sheet
    k = 2
    wshMyData.Range("A2:E" & i).Copy wshResult.Range("A" & k)
    k = k + i - 1
    wshBrokersData.Range("A2:E" & j).Copy wshResult.Range("A" & k)
    k = k + j - 2
    'remove duplicates
    wshResult.Range("$A$1:$E$" & k).RemoveDuplicates Columns:=Array(2, 3, 4, 5), Header:=xlYes
    k = wshResult.Range("A" & wshResult.Rows.Count).End(xlUp).Row
    'start comparison ;)
    'my data
    sTmp = "(" & wshMyData.Name & "!" & wshMyData.Range("B1:B" & i).AddressLocal & "=B2)"
    sTmp = sTmp & "*(" & wshMyData.Name & "!" & wshMyData.Range("C1:C" & i).AddressLocal & "=C2)"
    sTmp = sTmp & "*(" & wshMyData.Name & "!" & wshMyData.Range("D1:D" & i).AddressLocal & "=D2)"
    sTmp = sTmp & "*(" & wshMyData.Name & "!" & wshMyData.Range("E1:E" & i).AddressLocal & "=E2)"
    sTmp = "=SUM(IF(" & sTmp & ", 1, 0))"
    wshResult.Range("F2").BorderAround LineStyle:=xlContinuous
    wshResult.Range("F2").FormulaArray = sTmp
    wshResult.Range("F2:F" & k).FillDown
    'brokres data
    sTmp = "(" & wshBrokersData.Name & "!" & wshBrokersData.Range("B1:B" & i).AddressLocal & "=B2)"
    sTmp = sTmp & "*(" & wshBrokersData.Name & "!" & wshBrokersData.Range("C1:C" & i).AddressLocal & "=C2)"
    sTmp = sTmp & "*(" & wshBrokersData.Name & "!" & wshBrokersData.Range("D1:D" & i).AddressLocal & "=D2)"
    sTmp = sTmp & "*(" & wshBrokersData.Name & "!" & wshBrokersData.Range("E1:E" & i).AddressLocal & "=E2)"
    sTmp = "=SUM(IF(" & sTmp & ", 1, 0))"
    wshResult.Range("G2").BorderAround LineStyle:=xlContinuous
    wshResult.Range("G2").FormulaArray = sTmp
    wshResult.Range("G2:G" & k).FillDown
    'autofit
    wshResult.Range("A:G").Columns.AutoFit
  

Exit_CompareData:
    On Error Resume Next
    Set wshMyData = Nothing
    Set wshBrokersData = Nothing
    Set wshResult = Nothing
    Set wbk = Nothing
    Exit Sub

Err_CompareData:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_CompareData

End Sub

结果：

如您所见，0表示所选工作表中没有相应的数据。

上面的宏是做什么的？

添加新工作表：Result，然后添加列标题（ID, Stock, Qty, Price, Date, My data,Broker在第 1 行分别在列A- G）
Sheet1将所有数据从工作表 ( )复制到Result工作表
Sheet2将经纪人工作表 ( ) 中的所有数据复制到工作Result表
删除工作Result表中的重复项（基于除之外的所有列ID）
在单元格中插入公式数组F2并G2填充它。

重要提示：至少还有其他几种方法可以实现这一目标......

最后说明：随意更改代码以满足您的需要。

arrays - VBA 比较 2 个数组并返回缺失的行，包括重复项

问题描述

解决方案

推荐阅读