VBA Application.Index 和 Application.Match 由于在源表中找不到而类型不匹配

Question

第一次海报，长期潜伏者。

我正在尝试为到目前为止我使用公式完成的事情创建一些 VBA 代码。具体来说，我想根据两个条件从 SourceSheet 中查找值，并将第 7 列中的值返回到 TargetSheet。这是为了提取一些财务数据，例如工作子类型的总体利润率百分比。

我遇到的问题不是所有 TargetSheets 行（Criteria1 和 Criteria3）都会在 SourceSheet 中找到，有些会找到但值将为空。这导致代码在以下部分抛出类型不匹配错误：

“如果 IsError(Application.Index(Source Range, Application.Match(Criteria1 and Criteria2, Source Range.Columns(4) & SourceRange.Columns(5), 0), 6)) 然后”

我尝试了很多不同的方法来解决这个问题，但都导致类型不匹配。任何帮助表示赞赏！

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

谢谢@DecimalTurn！

这是我使用自定义函数更新后的代码，但我试着让它运行 20 分钟，但只是旋转......

Function MatchWith2Criteria(LookUpRange1 As Range, Criteria1 As Variant, LookUpRange2 As Range, Criteria2 As Variant) As Variant

    'N/A by default
    MatchWith2Criteria = CVErr(xlErrNA)

    'We need the two ranges to have the same height or we won't be able to align them
    If (LookUpRange1.Rows.Count <> LookUpRange2.Rows.Count) Then
        Exit Function
    End If

    'Here we are storing the values from the ranges inside arrays. This is mainly to improve performance as VBA doesn't have to access the worksheet data constantly.
    Dim arr1() As Variant
    arr1 = LookUpRange1.Columns(1).Value2
    Dim arr2() As Variant
    arr2 = LookUpRange2.Columns(1).Value2
    
    Dim i As Long
    For i = 1 To UBound(arr1)
        If arr1(i, 1) = Criteria1 And arr2(i, 1) = Criteria2 Then
            MatchWith2Criteria = i
            Exit Function
        End If
    Next

End Function

Sub Margin_Trade_Update_V2()


' Update JCA tab with MTD Trade Margin

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 & File")
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
        Dim MyMatch As Variant
        MyMatch = MatchWith2Criteria(SourceSheet.Columns(3), Criteria1, SourceSheet.Columns(4), Criteria2)
        If IsError(MyMatch) Then
            TargetRange.Value2 = ""
        Else
            TargetRange.Value2 = Application.Index(SourceRange, MyMatch, 6)
        End If

Next i

End Sub

最后感谢@DecimalTurn 帮助我度过难关！

这是我所做更改的最终代码和一些 cmets：

'Needed to define the function so instead of figuring out how to nest it i just went the 'ol fashioned way

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()


' Update JCA tab with MTD Trade Margin

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
        'N/A by default
        MyMatch = CVErr(xlErrNA)
        
        Dim LookUpRange1 As Range
        Dim LookUpRange2 As Range
'needed to define SourceSheetLastRow
        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))
                
            'Here we are storing the values from the ranges inside arrays. This is mainly to improve performance as VBA doesn't have to access the worksheet data constantly.
            Dim arr1() As Variant
            'Note here that you don't need to specify Columns(1) if LookUpRange is always a single-column range.
            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 = i - Needed to be j in this loop
                    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

Answer 1

您的问题来自这样一个事实，即当您执行 SourceRange.Columns(4) & SourceRange.Columns(5) 时，您试图将两个范围与“&”运算符组合。您正在尝试连接两个范围，但 VBA 只知道如何连接字符串或可以直接转换为字符串的类型，因此这解释了类型错误。

在这种情况下，由于您尝试在 VBA 中进行多条件匹配，因此当您使用动态数组公式时，您不能完全使用通常在 Excel 中使用的语法。

如果您想使用该语法，则必须创建自己的辅助列，并将第 3 列和第 4 列的数据连接起来。

或者您也可以像这样使用自定义 VBA 函数：

Function MatchWith2Criteria(LookUpRange1 As Range, Criteria1 As Variant, LookUpRange2 As Range, Criteria2 As Variant) As Variant

    'N/A by default
    MatchWith2Criteria = CVErr(xlErrNA)

    'We need the two ranges to have the same height or we won't be able to align them
    If (LookUpRange1.Rows.Count <> LookUpRange2.Rows.Count) Then
        Exit Function
    End If

    'Here we are storing the values from the ranges inside arrays. This is mainly to improve performance as VBA doesn't have to access the worksheet data constantly.
    Dim arr1() As Variant
    arr1 = LookUpRange1.Columns(1).Value2
    Dim arr2() As Variant
    arr2 = LookUpRange2.Columns(1).Value2
    
    Dim i As Long
    For i = 1 To UBound(arr1)
        If arr1(i, 1) = Criteria1 And arr2(i, 1) = Criteria2 Then
            MatchWith2Criteria = i
            Exit Function
        End If
    Next

End Function

然后，你可以在你的代码中做这样的事情：

        Dim MyMatch As Variant
        MyMatch = MatchWith2Criteria(SourceSheet.Columns(3), Criteria1, SourceSheet.Columns(4), Criteria2)
        If IsError(MyMatch) Then
            TargetRange.Value2 = ""
        Else
            TargetRange.Value2 = Application.Index(SourceRange,MyMatch,6)
        End If

关于性能（更新）

正如您在 cmets 中提到的，当您拥有大量数据时，这种方法可能会很慢，因此一种解决方案是减少所涉及的数据量。

为了减少涉及的数据量，您可以传递一个大小有限的范围，而不是传递整个列。那么SourceSheet.Columns(3)就会变成这样：

SourceSheet.Range(SourceSheet.Cells(1,3),SourceSheet.Cells(SourceSheetLastRow,3))

你可以在哪里计算SourceSheetLastRow，就像计算LastRow一样，即：

'Determine the last row in the source sheet (based on column A)
SourceSheetLastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row

这可能有助于提高性能，但您也可以通过将函数代码合并到您的过程中来减少对电子表格的访问次数，从而进一步提高性能，如下所示：

    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, "C").Value
        Criteria2 = TargetSheet.Cells(i, "D").Value
        Set TargetRange = TargetSheet.Cells(i, "B")
    
        '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(3), 0)
            Dim MatchTrade As Long
            MatchTrade = MatchOrZero(Criteria2, .Columns(4), 0)
        End With

        'Use INDEX and MATCH to retrieve the value from the source range
        Dim MyMatch As Variant
        'N/A by default
        MyMatch = CVErr(xlErrNA)
        
        Dim LookUpRange1 As Range
        Dim LookUpRange2 As Range
        
        If LookUpRange1 Is Nothing Then
            Set LookUpRange1 = SourceSheet.Range(SourceSheet.Cells(1, 3), SourceSheet.Cells(SourceSheetLastRow, 3))
            Set LookUpRange2 = SourceSheet.Range(SourceSheet.Cells(1, 4), SourceSheet.Cells(SourceSheetLastRow, 4))
                
            'Here we are storing the values from the ranges inside arrays. This is mainly to improve performance as VBA doesn't have to access the worksheet data constantly.
            Dim arr1() As Variant
            'Note here that you don't need to specify Columns(1) if LookUpRange is always a single-column range.
            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 = i
                    Exit For
                End If
            End If
        Next j
         
        If IsError(MyMatch) Then
            TargetRange.Value = ""
        Else
            TargetRange.Value2 = Application.Index(SourceRange, MyMatch, 6)
        End If

    Next i

这里的技巧是 LookUpRange1 Is Nothing 仅在 for 循环的第一次迭代中为真，因此它只允许我们从工作表数据中读取一次。

请注意，我们还在标准中使用嵌套的 if 语句，因此如果第一个标准为假，我们不会评估第二个标准（更多关于为什么 here）。

您可能会使用更多技巧，例如this article 中讨论的技巧。在这里最有帮助的可能是前两个。以下是我通常使用它们的方式：

    Dim InitialCalculationMode As Variant: InitialCalculationMode = Application.Calculation

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    
    On Error GoTo RestoreAppConfig
    
    'Your code that takes a while to run
    
RestoreAppConfig:

    With Application
        .Calculation = InitialCalculationMode
        .ScreenUpdating = True
    End With

---

或者，您也可以将一个数组传递给 Match 函数，其中两列已经按元素级联。您可以使用如下函数执行连接：

Function ConcatenateElementWise(rng1 As Range, rng2 As Range) As Variant()

    'Convert to array
    Dim arr1() as Variant
    arr1 = rng1.Value2
    Dim arr2() as Variant
    arr2 = rng2.Value2
          
    Dim result() As Variant
    ReDim result(LBound(arr1) To UBound(arr1))
    
    Dim i As Long
    For i = LBound(arr1) To UBound(arr1)
        result(i) = arr1(i, 1) & arr2(i, 1)
    Next i

    ConcatenateElementWise = result
    
End Function

然后用ConcatenateElementWise(SourceRange.Columns(4), SourceRange.Columns(5))替换SourceRange.Columns(4) & SourceRange.Columns(5)