在 VBA 中查找数组中的匹配值

Question

这是一个非常基本的问题，但我的 VBA 技能相当生疏。我有两个工作表，其中一台机器只是将数据转储到其中。每张纸只有一列，SheetA 有 ~250 行，SheetB 有 ~1300 行。所以我需要做的是将 sheetA 中的第一个值与 sheetB 中的每个值进行比较，如果找到匹配项，我需要将其复制到另一张表（SheetC），然后移动到 SheetA 中的下一个值并重复此操作直到每个值已将 SheetA 中的值与 SheetB 中的每个值进行了比较。我认为最好的方法是使用数组，但我一生都不记得如何进行实际比较。下面是调用我认为的工作表和数组的代码....任何帮助表示赞赏！

Dim SheetA As Variant
Dim SheetB As Variant
Dim RangeToCheckA As String
Dim RangeToCheckB As String

'Get the worksheets from the workbooks
Set wbkA = Workbooks.Open(Filename:="H:\Chelsea QE\CD6\Evan West\OSM37 with locations 9-30-19.xls")
Set SheetA = wbkA.Worksheets("OSM37")

Set wbkB = Workbooks.Open(Filename:="H:\Chelsea QE\CD6\Evan West\New folder\Flat Rock and Roush VIN Tracker U625 - U611 Lower control arm welds.xlsx")
Set SheetB = wbkB.Worksheets("Master VIN")

'This is the range in SheetA
RangeToCheckA = "B2:B239"
'This is the range in SheetB
RangeToCheckB = "B4:B1339"

SheetA = SheetA.Range(RangeToCheckA)
SheetB = SheetB.Range(RangeToCheckB)

Answer 1

无需更改大部分代码并添加对自定义函数的调用，您可以执行以下操作：

Private Sub CompareWorkBooks()

    Dim wbkA As Workbook, wbkB As Workbook
    Dim SheetA As Worksheet, SheetB As Worksheet, SheetC As Worksheet
    Dim RangeToCheckA As String
    Dim RangeToCheckB As String
    Dim arrySheetA() As Variant, arrySheetB() As Variant, _
        arryOut() As Variant

    'Get the worksheets from the workbooks
    Set wbkA = Workbooks.Open(Filename:="H:\Chelsea QE\CD6\Evan West\OSM37 with locations 9-30-19.xls")
    Set SheetA = wbkA.Worksheets("OSM37")

    Set wbkB = Workbooks.Open(Filename:="H:\Chelsea QE\CD6\Evan West\New folder\Flat Rock and Roush VIN Tracker U625 - U611 Lower control arm welds.xlsx")
    Set SheetB = wbkB.Worksheets("Master VIN")

    'This is the range in SheetA
    RangeToCheckA = "B2:B239"
    'This is the range in SheetB
    RangeToCheckB = "B4:B1339"

    'Value 2 is faster as it doesn't copy formatting
    arrySheetA() = SheetA.Range(RangeToCheckA).Value2
    arrySheetB() = SheetB.Range(RangeToCheckB).Value2

    Set SheetC = wbkB.Worksheets("Sheet C")

    arryOut() = FastLookUp(arrySheetA, arrySheetB, 1, 1, 1)

    SheetC.Range("A1").Resize(UBound(arryOut, 1), _
                                  UBound(arryOut, 2)).Value = arryOut

End Sub

FastLookUp 功能：

Private Function FastLookUp(ByRef arryLookUpVals As Variant, ByRef arryLookUpTable As Variant, _
                           ByVal lngLookUpValCol As Long, ByVal lngSearchCol As Long, _
                           ByVal lngReturnCol As Long, _
                           Optional ByVal boolBinaryCompare As Boolean = True) As Variant

  Dim i As Long
  Dim dictLooUpTblData As Object
  Dim varKey As Variant
  Dim arryOut() As Variant

        Set dictLooUpTblData = CreateObject("Scripting.Dictionary")
        If boolBinaryCompare Then
            dictLooUpTblData.CompareMode = vbBinaryCompare
        Else
            dictLooUpTblData.CompareMode = vbTextCompare
        End If

        'add lookup table's lookup column to
        'dictionary
        For i = LBound(arryLookUpTable, 1) To UBound(arryLookUpTable, 1)

            varKey = Trim(arryLookUpTable(i, lngSearchCol))

            If Not dictLooUpTblData.Exists(varKey) Then
                'this is called a silent add with is faster
                'than the standard dictionary.Add Key,Item
                'method
                dictLooUpTblData(varKey) = arryLookUpTable(i, lngReturnCol)
            End If

            varKey = Empty
        Next i

        i = 0: varKey = Empty

        ReDim arryOut(1 To UBound(arryLookUpVals, 1), 1 To 1)

        For i = LBound(arryLookUpVals, 1) To UBound(arryLookUpVals, 1)
            varKey = Trim(arryLookUpVals(i, lngLookUpValCol))

            'if the lookup value exists in the dictionary
            'at this index of the array, then return
            'its correspoding item
            If dictLooUpTblData.Exists(varKey) Then
                arryOut(i, 1) = dictLooUpTblData.Item(varKey)
            End If

            varKey = Empty
        Next i

    FastLookUp = arryOut

End Function

FastLookup 的功能与VLOOKUP 完全相同，但更灵活一些，因为查找列不必是您要查找的范围中的第一个，因为您可以指定哪一列通过为lngLookUpValCol 参数提供一个值。

Answer 2

关于您在 1 个工作簿中有 3 个工作表 - Worksheets(1) 和 Worksheets(2) 是其中一个，其中比较了 Range("A1:A7") 和 Range("A1:A3") 中的值：

Sub TestMe()

    Dim arrA As Variant
    Dim arrB As Variant

    With Application
        arrA = .Transpose(Worksheets(1).Range("A1:A7"))
        arrB = .Transpose(Worksheets(2).Range("A1:A3"))
    End With

    Dim a As Variant
    Dim b As Variant

    For Each a In arrA
        For Each b In arrB
            If a = b Then
                Worksheets(3).Cells(1 + LastRow(Worksheets(3).Name), 1) = b
            End If
        Next
    Next

End Sub

Function LastRow(wsName As String, Optional columnToCheck As Long = 1) As Long
    Dim ws As Worksheet
    Set ws = Worksheets(wsName)
    LastRow = ws.Cells(ws.Rows.Count, columnToCheck).End(xlUp).Row
End Function

如果您打算使用上面的代码，最好确保Worksheets(1) 中的值都是唯一的，否则代码会重复 N 次。或者添加字典，排除重复值。