Использование функции сопоставления и индекса VBA

Всякий раз, когда я работаю с кодом, выполняющим множество операций поиска в одном и том же диапазоне, я обычно упаковываю этот диапазон поиска в словарь. Поиск в словаре очень эффективен, поэтому вам не нужно беспокоиться о стоимости поиска. Наполнение словаря связано с накладными расходами, но они часто восстанавливаются по мере роста числа поисковых запросов.

Я использовал этот подход в приведенном ниже решении. Я использую вспомогательные функции для создания словаря и поиска значений словаря. Это помогает избавиться от основной рутины. Посмотрите, сможете ли вы работать с приведенным ниже кодом, и адаптируйте его к своему решению. Я прокомментировал это там, где, по моему мнению, это добавит ценности, и я думаю, что вы должны быть в состоянии адаптироваться к своим потребностям. Пишите по любым вопросам.

Sub RefreshStuff()
    Dim matchRange As Range
    Dim oDict As Object
    Dim lastRow As Long
    Dim lookupRange As Range
    Dim wsDest As Worksheet
    
    'This holds the lookup range (including both the lookup key
    'column and the value column)
    Set matchRange = Sheets("Parts List").Range("E1:F6")
    
    'Get a dictionary of all the lookup values. The function, as
    'defined below, takes the range as well as the relative column
    'of the keys and values. In our case, the first column of our
    'range has the keys, and the second has the values
    Set oDict = GetDictionary(matchRange, 1, 2)
    
    'Below, define the lookup range. In your specific code, this
    'varies based on the combobox value, but I think you'll be able
    'to figure out how to define it (I'm just hardcoding mine
    lastRow = 10
    Set wsDest = Sheets("Job Card Master")
    Set lookupRange = wsDest.Range("A1:A" & lastRow)
    
    'Loop over the lookup range
    For i = 1 To lastRow
        'Since the GetPartInfo function handles cases where there isn't a match
        ' (it returns a blank string), you don't have to use an if/else statement
        wsDest.Range("B" & i).Value = GetPartInfo(oDict, wsDest.Range("A" & i).Value)
    Next i
End Sub


Private Function GetDictionary(rng As Range, keyCol As Long, valCol As Long) As Object
    Dim sht As Worksheet
    Dim rCell As Range
    Dim oDict As Object
    
    Set sht = rng.Parent
    Set oDict = CreateObject("Scripting.Dictionary")
    
    For Each rCell In rng.Columns(keyCol).Cells
        If Not oDict.exists(rCell.Offset(, keyCol - 1).Value) Then
            oDict.Add rCell.Offset(, keyCol - 1).Value, rCell.Offset(, valCol - 1).Value
        End If
    Next rCell
    
    Set GetDictionary = oDict
End Function

'This is just a helper function to de-clutter the main subroutine. Returns an
' empty string in cases where the part doesn't exist in the dictionary
Private Function GetPartInfo(ByRef oDict As Object, sKey As String)
    Dim output As String
    
    output = ""
    
    If oDict.exists(sKey) Then
        output = oDict(sKey)
    End If
    
    GetPartInfo = output
End Function