Question

我目前正试图弄清楚如何编写一个允许我使用两个条件运行索引/匹配的宏。我有一个包含来自多个国家的交易信息的大型信息数据库。我想引用“国家/地区”列和“日期”列中的数据，以匹配包含外汇汇率的单独工作表。对于与之匹配的国家/地区和日期，将返回该日期的汇率。我希望宏可以运行到我工作表中的最后一行数据（它会不时变化）

我最初创建的公式语法是：

=INDEX('FX_Index Lookup'!G:G,MATCH('Tool'!CJ2&'Tool'!DT2,'FX_Index Lookup'!C:C&'FX_Index Lookup'!H:H,0),FALSE)

当我拖动此公式时，excel耗尽资源以继续运行我需要的数据（行）数量的计算。我希望宏可以解决这个问题

Answer 1

最后一个函数MatchQuery将返回ReturnCol列中的单元格，其中CriteriaColA = CriteriaA，CriteriaColB = CriteriaB ...（与SUMIFS类似的语法）

设置rngRes = MatchQuery（ReturnCol，CriteriaColA，CriteriaA，CriteriaColB，CriteriaB ......等）

Public Function IsRange(ByRef vnt As Variant) As Boolean
    If IsObject(vnt) Then
        If Not vnt Is Nothing Then
            IsRange = TypeOf vnt Is Excel.Range
        End If
    End If
End Function

Public Function Union(ByRef rng1 As Range, _
                      ByRef rng2 As Range) As Range
    If rng1 Is Nothing Then
        Set Union = rng2
        Exit Function
    End If
    If rng2 Is Nothing Then
        Set Union = rng1
        Exit Function
    End If
    If Not rng1.Worksheet Is rng2.Worksheet Then
        Exit Function
    End If
    Set Union = Application.Union(rng1, rng2)
End Function

Public Function MatchAll(ByRef vntLookupValue As Variant, _
                         ByRef rngLookupArray As Range) As Range
    Dim rngArea As Range
    Dim rngTemp1 As Range
    Dim rngTemp2 As Range
    Dim vntMatch As Variant
    Dim lngCount As Long
    Dim lngLast As Long

    If rngLookupArray Is Nothing Then
        Exit Function
    End If
    For Each rngArea In rngLookupArray.Areas
        If rngArea.Columns.Count > rngArea.Rows.Count Then
            Set rngTemp1 = rngArea.Rows
        Else
            Set rngTemp1 = rngArea.Columns
        End If
        For Each rngTemp2 In rngTemp1
            With rngTemp2
                lngCount = .Cells.Count
                lngLast = 0
                Do
                    vntMatch = Application.Match(vntLookupValue, .Parent.Range(.Cells(lngLast + 1), .Cells(lngCount)), 0)
                    If IsError(vntMatch) Then
                        Exit Do
                    End If
                    lngLast = lngLast + vntMatch
                    Set MatchAll = Union(MatchAll, .Cells(lngLast))
                Loop Until lngLast = lngCount
            End With
        Next rngTemp2
    Next rngArea
End Function

Public Function MatchQuery(ByRef rngLookupArray As Range, _
                           ParamArray avntArgs() As Variant) As Range
    Dim rngResult As Range
    Dim i As Long
    Dim rngTemp As Range
    Dim rngMatches As Range

    Set rngResult = rngLookupArray
    For i = 0 To UBound(avntArgs) - 1 Step 2
        If Not IsRange(avntArgs(i)) Then
            Exit Function
        End If
        Set rngTemp = avntArgs(i)
        Set rngMatches = MatchAll(avntArgs(i + 1), Intersect(rngResult.EntireRow, rngTemp))
        If rngMatches Is Nothing Then
            Exit Function
        End If
        Set rngResult = Application.Intersect(rngResult, rngMatches.EntireRow)
    Next i
    Set MatchQuery = rngResult
End Function

VBA：索引/匹配多个标准

1 个答案: