Question

尝试在指定范围内使用匹配和索引。无法识别代码中的 RefreshDrNumbers。

我正在使用 Case 函数来指定范围。

似乎无法使 Case、Match 和 Index 函数相互连接或通信？

我问过的另一个论坛是

https://www.mrexcel.com/board/threads/add-ranges-to-match-and-index-functions.1162701/

Private Sub Jobcard_Demands_Click()

     If Jobcard_Demands = ("Drawing No`s Update") Then

    Dim matchRange As Range
    Dim ODict As Object
    Dim PartsListLastRow As Long, DestLastRow As Long
    Dim LookupRange As Range
    Dim i As Integer
    Dim wsSource As Worksheet, wsDest As Worksheet
    
    Set wsSource = ThisWorkbook.Worksheets("Parts List")
    Set wsDest = ThisWorkbook.Worksheets("Job Card Master")
    
    PartsListLastRow = wsSource.Range("A" & Rows.Count).End(xlUp).Row
    DestLastRow = wsDest.Range("A" & Rows.Count).End(xlUp).Row
    
    'This holds the lookup range (including both the lookup key
    'column and the value column)
    Set matchRange = wsSource.Range("E1:F" & PartsListLastRow)
    
    '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, 5, 6)
    
    '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
    Set LookupRange = wsDest.Range("A1:A" & DestLastRow)
    
    'Loop over the lookup range
    For i = 1 To DestLastRow
        '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("E" & i).Value)
    Next i
    End If
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

Answer 1

每当我使用在同一范围内执行多次查找的代码时，我倾向于将该查找范围打包到字典中。在字典中查找非常高效，因此您不必担心查找的“成本”。填充字典会产生开销，但随着查找次数的增加，这通常会恢复。

我在下面的解决方案中采用了这种方法。我使用辅助函数来创建字典和查找字典值。这有助于整理主要例程。看看您是否可以使用下面的代码，并将其调整为您的解决方案。我在我认为它会增加价值的地方对其进行了评论，我认为您应该能够适应您的需求。有任何问题请回信。

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

使用 VBA 匹配和索引功能

1 个答案: