Поиск совпадающих значений в массивах в 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

Относительно того, что у вас есть 3 листа в 1 рабочей книге - 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 раз. Или добавьте словарь, чтобы исключить повторяющиеся значения.