多条件下Application.Index与Application.Match类型不匹配问题解决

需求：从SourceSheet中根据两个条件查找数据，将第7列的值返回至TargetSheet，用于提取作业子类型整体利润率等财务数据。

问题：部分TargetSheet行的条件在SourceSheet中无匹配，或匹配到的值为空，导致代码判断IsError(Application.Index(...))时抛出类型不匹配错误，尝试多种方法均未解决。

问题代码 #

Sub Margin_Trade_Update()

Dim SourceWB As Workbook, TargetWB As Workbook
Dim SourceSheet As Worksheet, TargetSheet As Worksheet
Dim Criteria1 As String, Criteria2 As String
Dim SourceRange As Range, TargetRange As Range
Dim MatchLC As Long, MatchTrade As Long
Dim LastRow As Long
Dim ResultCol As Long

'Set the source and target workbooks
Set SourceWB = Workbooks.Open("Path and Source workbook name")
Set TargetWB = ThisWorkbook

'Set the source and target worksheets
Set SourceSheet = SourceWB.Sheets("Margin - Trade")
Set TargetSheet = TargetWB.Sheets("01-25")

'Delete the first two rows of margin trade sheet
SourceSheet.Range("A1:A2").EntireRow.Delete

'Determine the last row in the target sheet
LastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row

'Iterate through the rows in the target sheet for MTD Trade Margin

For i = 2 To LastRow
    
    'Set the criteria and target range
    Criteria1 = TargetSheet.Cells(i, "H").Value
    Criteria2 = TargetSheet.Cells(i, "M").Value
    Set TargetRange = TargetSheet.Cells(i, "AB")
    
    'Find the match row and column in the source range
    With SourceSheet
        Set SourceRange = .Range(.Cells(1, 1), .Cells(.Rows.Count, .Columns.Count))
        MatchLC = IIf(IsError(Application.Match(Criteria1, .Columns(4), 0)), 0, Application.Match(Criteria1, .Columns(4), 0))
        MatchTrade = IIf(IsError(Application.Match(Criteria2, .Columns(5), 0)), 0, Application.Match(Criteria2, .Columns(5), 0))
    End With

    'Use INDEX and MATCH to retrieve the value from the source range
    If IsError(Application.Index(SourceRange, Application.Match(Criteria1 & Criteria2, SourceRange.Columns(4) & SourceRange.Columns(5), 0), 6)) Then
        TargetRange.Value = ""
    Else
        TargetRange.Value = Application.Index(SourceRange, Application.Match(Criteria1 & Criteria2, SourceRange.Columns(4) & SourceRange.Columns(5), 0), 6)
        On Error GoTo 0
    End If

Next i

'Close the source workbook
SourceWB.Close SaveChanges:=False

End Sub

修改后的最终代码及注释 #

'自定义函数处理匹配失败的情况，避免嵌套判断的繁琐
Function MatchOrZero(ByVal LookupVal As Variant, ByVal LookupRange As Range, Optional ByVal ReturnType As Long = 1) As Variant
    On Error Resume Next
    MatchOrZero = Application.Match(LookupVal, LookupRange, ReturnType)
    If IsError(MatchOrZero) Then
        MatchOrZero = 0
    End If
    On Error GoTo 0
End Function


Sub Margin_Trade_Update_V3()

' 更新JCA工作表的MTD交易利润率数据

Dim SourceWB As Workbook, TargetWB As Workbook
Dim SourceSheet As Worksheet, TargetSheet As Worksheet
Dim SourceRange As Range, TargetRangeMTD As Range, TargetRangeLTD As Range
Dim LastRow As Long
Dim ResultCol As Long

'Set the source and target workbooks
Set SourceWB = Workbooks.Open("Path & File Here")
Set TargetWB = ThisWorkbook

'Set the source and target worksheets
Set SourceSheet = SourceWB.Sheets("Margin - Trade")
Set TargetSheet = TargetWB.Sheets("01-25")

'Delete the first two rows of margin trade sheet
SourceSheet.Range("A1:A2").EntireRow.Delete

'Determine the last row in the target sheet
LastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row

'Iterate through the rows in the target sheet for MTD Trade Margin
Dim i As Long
For i = 2 To LastRow
    
    'Set the criteria and target range
    Dim Criteria1 As String, Criteria2 As String
    Criteria1 = TargetSheet.Cells(i, "H").Value
    Criteria2 = TargetSheet.Cells(i, "M").Value
    Set TargetRangeMTD = TargetSheet.Cells(i, "AB")
    Set TargetRangeLTD = TargetSheet.Cells(i, "AC")
    
    'Find the match row and column in the source range
    With SourceSheet
        Set SourceRange = .Range(.Cells(1, 1), .Cells(.Rows.Count, .Columns.Count))
        Dim MatchLC As Long
        MatchLC = MatchOrZero(Criteria1, .Columns(4), 0)
        Dim MatchTrade As Long
        MatchTrade = MatchOrZero(Criteria2, .Columns(5), 0)
    End With

    'Use INDEX and MATCH to retrieve the value from the source range
    Dim MyMatch As Variant
    '默认设为错误值，表示无匹配
    MyMatch = CVErr(xlErrNA)
        
    Dim LookUpRange1 As Range
    Dim LookUpRange2 As Range
'定义源工作表的最后一行
    Dim SourceSheetLastRow As Long
    SourceSheetLastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row

    If LookUpRange1 Is Nothing Then
        Set LookUpRange1 = SourceSheet.Range(SourceSheet.Cells(1, 4), SourceSheet.Cells(SourceSheetLastRow, 4))
        Set LookUpRange2 = SourceSheet.Range(SourceSheet.Cells(1, 5), SourceSheet.Cells(SourceSheetLastRow, 5))
                
        '将数据存入数组，减少工作表访问次数提升性能
        Dim arr1() As Variant
        '如果LookupRange是单列，无需指定Columns(1)
        arr1 = LookUpRange1.Columns(1).Value2
        Dim arr2() As Variant
        arr2 = LookUpRange2.Columns(1).Value2
    End If
        
    Dim j As Long
    For j = 1 To UBound(arr1)
        If arr1(j, 1) = Criteria1 Then
            If arr2(j, 1) = Criteria2 Then
                '匹配成功，记录行号
                MyMatch = j
                Exit For
            End If
        End If
    Next j
         
    If IsError(MyMatch) Then
        TargetRangeMTD.Value = ""
        TargetRangeLTD.Value = ""
    Else
        TargetRangeMTD.Value2 = Application.Index(SourceRange, MyMatch, 6)
        TargetRangeLTD.Value2 = Application.Index(SourceRange, MyMatch, 7)
    End If

Next i

End Sub

内容的提问来源于stack exchange，提问作者Nodnarb