索引匹配VBA

时间:2014-11-29 11:40:24

标签: excel-vba vba excel

我正在尝试将以下INDEX(),MATCH()函数转换为VBA:

=INDEX($C$2:$N$21;MATCH($A24&CHAR(1)&C$23;$A$2:$A$21&CHAR(1)&$B$2:$B$21;0); MATCH($B24;$C$1:$N$1;0))

我在StackOverflow上找到了以下设置:

Dim INDEX_ARRAY As Range
Dim INDEX_COLUMN As Range
Dim INDEX_ROW As Range

With Worksheets("Master Scores")
    Set INDEX_ARRAY = .Range(.Cells.Find(iCell.Value).EntireColumn))
    Set INDEX_COLUMN = .Range("A1:A500"))
End With

With Worksheets("EXPORT")
    Set INDEX_ROW = .Range(.Cells(iCell.Row,1))
End WIth

iCell.Formula = Application.Index(INDEX_ARRAY, INDEX_ROW, INDEX_COLUMN)

但是,我不知道如何将MATCH($A24&CHAR(1)&C$23;$A$2:$A$21&CHAR(1)&$B$2:$B$21;0)部分转换为VBA。

我非常感谢您的意见!

提前致谢,

Hieronymus5

1 个答案:

答案 0 :(得分:0)

所以对于每个人都有同样的问题,这里是Jindon在Ozgrid论坛上写的一段精彩的VBA代码。它比单元格或worksheetfunction.index / match变体中的引用快很多。

Sub test() 
    Dim a, i As Long, ii As Long, dic As Object, txt As String 
    Set dic = CreateObject("Scripting.Dictionary") 
    dic.CompareMode = 1 
    a = Sheets("sheet2").Cells(1).CurrentRegion.Value 
    With CreateObject("Scripting.Dictionary") 
        .CompareMode = 1 
        For i = 3 To UBound(a, 1) 
            If Not dic.exists(a(i, 2)) Then dic(a(i, 2)) = Empty 
            For ii = 3 To UBound(a, 2) 
                txt = a(i, 1) & Chr(2) & a(2, ii) 
                If Not .exists(txt) Then 
                    Set .Item(txt) = CreateObject("Scripting.Dictionary") 
                End If 
                .Item(txt)(a(i, 2)) = a(i, ii) 
            Next 
        Next 
        Redim a(1 To .Count + 2, 1 To dic.Count + 2) 
        a(1, 1) = "Code": a(1, 2) = "Variable Code" 
        For i = 0 To dic.Count - 1 
            a(1, i + 3) = dic.keys()(i) 
        Next 
        For i = 0 To .Count - 1 
            a(i + 2, 1) = Split(.keys()(i), Chr(2))(0) 
            a(i + 2, 2) = Split(.keys()(i), Chr(2))(1) 
            For ii = 3 To UBound(a, 2) 
                If .items()(i).exists(a(1, ii)) Then 
                    a(i + 2, ii) = .items()(i)(a(1, ii)) 
                End If 
            Next 
        Next 
    End With 
    Application.ScreenUpdating = False 
    With Sheets.Add.Cells(1).Resize(UBound(a, 1), UBound(a, 2)) 
        .Value = a: .Columns.AutoFit 
    End With 
    Application.ScreenUpdating = True 
End Sub