VBA 二维数组查找并定位数据

数据源:

 

将这个二维数组导入内存后,存储到一个二维数组里,查找其中一个数组成员,返回其在表格中的地址.

如找44,返回M20

Function FindAll(outDict As Object, what As String, scrRngs As Range, Optional isOne As Boolean = False)
'what       参数2: 要查找的数据
'scrRngs    参数3: 查找的范围 , 包含二维数组或一维数组的单元格
'outDict    参数1: 考虑会有多个结果,使用字典存储单元格地址
'                   key存储单元格地址,item存储数组坐标
'isOne      参数4: 可选,默认是False.设置True,找到一个结果后就结束.

    If scrRngs.Count < 2 Then   '如果传进来的单元格只有一个
        If what = scrRngs.Value Then
            outDict.Add scrRngs.Address, "1-1"
            FindAll = True
            Exit Function
        Else
            FindAll = False
            Exit Function
        End If
    Else
        arr = scrRngs.Value
        arr_min = LBound(arr)           '数组最小元素
        arr_max_row = UBound(arr)       '二维数组的最大行数
        arr_max_col = UBound(arr, 2)    '二维数组的最大列数
        
        FindAll = False
        For Row = 1 To arr_max_row
            For col = 1 To arr_max_col
                If CStr(arr(Row, col)) = CStr(what) Then
                    outDict.Add scrRngs.Cells(Row, col).Address, Row & "-" & col
                    FindAll = True
                    If isOne Then Exit Function
                End If
            Next
        Next
    End If
End Function

Function FindColumn(outDict As Object, what As String, scrRngs As Range, Optional Column As Integer = 1, Optional Offset As Integer = 0, Optional isOne As Boolean = False)
'what       参数2: 要查找的数据
'scrRngs    参数3: 查找的范围 , 包含二维数组或一维数组的单元格
'Column     参数4: 在哪一列查找
'outDict    参数1: 考虑会有多个结果,使用字典存储单元格地址
'                   key存储单元格地址,item存储偏移后单元格地址
'Offset     参数5: 找到后向左右偏移的量,正数向右,负数向左
'isOne      参数6: 可选,默认是False.设置True,找到一个结果后就结束.

    If scrRngs.Count < 2 Then   '如果传进来的单元格只有一个
        If what = scrRngs.Value Then
            outDict.Add scrRngs.Address, "1-1"
            FindColumn = True
            Exit Function
        Else
            FindColumn = False
            Exit Function
        End If
    Else
        arr = scrRngs.Value
        arr_min = LBound(arr)           '数组最小元素
        arr_max_row = UBound(arr)       '二维数组的最大行数
        arr_max_col = UBound(arr, 2)    '二维数组的最大列数
        
        If Column + Offset > arr_max_col Then   '要查找的列大于列数是错误的
            FindColumn = False
            MsgBox ("要查找的列或向右偏移量过大")
            Exit Function
        End If
        If Column + Offset < 1 Then '向左偏移量过大
            FindColumn = False
            MsgBox ("向左偏移量过大")
            Exit Function
        End If
        
        FindColumn = False
        For Row = 1 To arr_max_row
            If CStr(arr(Row, Column)) = CStr(what) Then
                outDict.Add scrRngs.Cells(Row, Column).Address, scrRngs.Cells(Row, Column + Offset).Address
                FindColumn = True
                If isOne Then Exit Function
            End If
        Next
    End If
End Function

Sub ddd()
    Dim Rngs As Range   '函数的参数规定了数据类型
    Dim outRng As Range '这里就一定要定义数据类型
    Dim sh As Worksheet
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    Set sh = Worksheets("Sheet3")
    Set Rngs = sh.Range("J12:N31")
    dict.RemoveAll
    success = FindColumn(dict, "3", Rngs, 3, -1, True)
    If b And dict.Count > 0 Then
        a = dict.keys()
        b = dict.items()
    End If
End Sub