VBA 中的 Vlookup 与 ARRAYS 中的 APROXIMATE MATCH 等效

Question

Summary of the problem is:

I have come up with the following VBA code that is working fine but taking too long to run. So, I am trying to process all the data taking into arrays. But I am stuck with Vlookup APPROXIMATE MATCH in ARRAYS .

The working VBA code is:

Option Explicit

Sub VlookupAlternative()
    
    Const INPUT_SHT = "shtSrc"
    Const OUTPUT_SHT = "shtDest"
    
    
    Dim wb As Workbook, wsIn As Worksheet, wsOut As Worksheet
    Dim rngSrc As Range, rngDest As Range, celSrc As Range, celDest As Range
    Dim rLastIn As Long, cLastIn As Long
    Dim rLastOut As Long, cLastOut As Long

    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    On Error Resume Next
    
    Set wb = ThisWorkbook
    Set wsIn = wb.Sheets(INPUT_SHT)
    Set wsOut = wb.Sheets(OUTPUT_SHT)
    
    
    rLastIn = lastRow(wsIn)
    cLastIn = LastCol(wsIn)
    
    rLastOut = lastRow(wsOut)
    cLastOut = LastCol(wsOut)
    
    With wb

        Set rngSrc = wsIn.Range("$A$2:$F$" & rLastIn)
        Set rngDest = wsOut.Range("$B$2:$D$" & rLastOut)
        
        
        ' Compare top headers and left headers respectively. If matching, copy the value in destination table.
        For Each celDest In rngDest
            For Each celSrc In rngSrc
                If wsIn.Cells(celSrc.Row, 1).Value = Application.IfError(Application.VLookup(CDbl(TimeValue(wsOut.Cells(celDest.Row, 1).Value)), rngSrc, 1, True), "") And _
                    wsIn.Cells(celSrc.Row, 3).Value = Format(wsOut.Cells(celDest.Row, 1).Value, "DDDD") And _
                    wsIn.Cells(1, celSrc.Column).Value = wsOut.Cells(1, celDest.Column).Value Then
                    celDest.Value = celSrc.Value
                End If
            Next celSrc
        Next celDest
    End With
    
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub


Function lastRow(sh As Worksheet)
    On Error Resume Next
    lastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function

The code I am trying to write with arrays :

Option Explicit

Sub VlookupAlternativeArray()
    
    Const INPUT_SHT = "shtSrc"
    Const OUTPUT_SHT = "shtDest"
    
    
    Dim wb As Workbook, wsIn As Worksheet, wsOut As Worksheet
    Dim rngSrc As Range, rngDest As Range, rngLookup As Range, rngReturn As Range
    Dim celSrc As Range, celDest As Range
    Dim rLastIn As Long, cLastIn As Long
    Dim rLastOut As Long, cLastOut As Long
    Dim lookupArray As Variant, returnArray As Variant, destArray As Variant

    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    On Error Resume Next
    
    Set wb = ThisWorkbook
    Set wsIn = wb.Sheets(INPUT_SHT)
    Set wsOut = wb.Sheets(OUTPUT_SHT)
    
    
    rLastIn = lastRow(wsIn)
    cLastIn = LastCol(wsIn)
    
    rLastOut = lastRow(wsOut)
    cLastOut = LastCol(wsOut)
    
    Set rngLookup = wsIn.Range("$A$2:$C$" & rLastIn)
    Set rngReturn = wsIn.Range("$D$2:$F$" & rLastIn)
    Set rngDest = wsOut.Range("$B$2:$D$" & rLastOut)

    
    lookupArray = rngLookup.Value2
    returnArray = rngReturn.Value2
    destArray = rngDest.Value2

'**********I want to put a vlookup approximate equivalent code here.*************************************************

                                            '    Dim desc As String
                                            '    Dim i As Long
                                            '    Dim j As Long
                                            '    For i = LBound(destArray, 1) To UBound(destArray, 1)
                                            '        desc = destArray(i, 1)
                                            '        For j = LBound(lookupArray, 1) To UBound(lookupArray, 1)
                                            '            If InStr(1, desc, lookupArray(j, 1), vbTextCompare) > 0 Then
                                            '                destArray(i, 2) = returnArray(j, 1)
                                            '                Exit For
                                            '            End If
                                            '        Next j
                                            '    Next i
'*********************************************************************************************************************

    wsOut.Range("B2").Resize(UBound(destArray, 1), 1).Value2 = Application.Index(destArray, 0, 2)

    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub


Function lastRow(sh As Worksheet)
    On Error Resume Next
    lastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function

As a beginner with VBA, I need a direction how to approach Vlookup APPROXIMATE MATCH in ARRAYS. Does Application.Vlookup work in Arrays? Is VBA Dictionary a better option here? Any code sample or advice will be much appreciated.

If you need a reference to the context of the code, it is detailed here .

Answer 1

There is no equivalent to VLOOKUP in VBA. Instead, Excel's own VLOOKUP can be used by VBA, but not its ISERROR() function. Your code runs slowly because it crashes on each attempt of running your formula and On Error Resume Next prevents it from stopping. It doesn't work. And it can't work because the ISERROR condition not only can't work in VBA but also can't make sense within your formula.

Not clear what you want to achieve but consider using Application.Match if you need approximate matches or Range.Find for exact ones.

Note that wsIn.Cells(celSrc.Row, 1) and wsOut.Cells(celDest.Row, 1) are circumscribing the ranges celSrc and celDest . Further, consider the difference between a cell's Value , Value2 , Formula and its display. When searching for dates or times Value2 holds a number, Value holds the formatted expression of that number (the displayed value). Formula may hold a copy of Value2 or the function that created Value2 .

Searching for both number and format makes no sense because they are essentially the same. But you do need to know which format of your search criterium you are looking for and in which property to find it. VBA's Range.Find allows you to search in values or formulas, the latter giving you access to Value2 (if no functions are used in the search data).

Finally, By assigning a WorksheetFunction.Match result to a variable of variant data type, like ...

Dim Match As Variant
Match = Application.Match(celSrc.Value, RngDest, 0)

the failure to match will result in vbError being assigned to the variable. You can trap that error with ...

If Match = vbError Then
    Match = 1      ' rectify the condition
End if

No On Error Resume Next is involved here because the Variant can itself store the error. Note that this will not work if you use WorksheetFunction.Match or if you assign the returned value to a variable of Long data type. Use On Error Resume Next only where you know which error to expect and have made provision for it to be handled by your code. Don't use it prophylactically. It doesn't work, as shown here. Instead it blindfolds you.

Finally, each reference to the sheet is slow. Therefore code will run significantly faster if many references can be made to arrays instead of cells. Indeed you could load your lookup values into arrays but not the lookup ranges. For now, your problem isn't that VLOOKUP doesn't work on arrays - which indeed it doesn't because arrays are VBA and ranges are Excel - but that your lookup doesn't work. Make your function work first and start worrying about speed thereafter.

Answer 2

Please read up on the presentation of dates and times in Excel. You will find that "03/01/2021 08"20 AM" in your ShSrc!A2 actually is an interpretation of the number 44199.3472222222 where 44199 describes the day and 0.347222222 is the time as a fraction of 1 (meaning 24 hours =1). This number is the Value of that cell which is given the format "mm/dd/yyyy hh:mm AM/PM".

It follows that the formula in C2 is (or should be) =A2 with a custom cell format of dddd which will display the same underlying number as "Sunday".

It further follows that all the times in ShSrc!A:B should be Date/Time values, as opposed to mere Time values that omit the day. This is a problem of data capture which we don't deal with here. The same applies to cell ShDest!A2.

Now that all your data are true date/times you can search and compare them. This is the formula for ShDest!B2.

=VLOOKUP($A2, ShSrc!$A$2:$F$5,COLUMN()+2,TRUE)

The formula is in column B. Therefore COLUMN() returns the number 2. The lookup column in ShSrc!$A$2:$F$5 is column D which has the number 4 which is equal to COLUMN()+2 you find in the formula. This little trick allows you to copy the formula from ShDest!B2 to C2:D2 where COLUMN() changes to 3, 4 and 5 and COLUMN() + 2, therefore, to 5, 6 and 7.

Frankly, I can't see how we can connect the above to your request to assistance with writing code. The immediate future requires determination of whether and why code is required at all, and if the answer is yes, any question you might ask would have to take the above into consideration, to wit, include the nature of your data.