[已解决]VBA代码的解读 - 关于查询匹配

glhfgtd

最近看到一份高手写的关于查询匹配数据的VBA代码，想自己加以应用，花了几个小时学习其中的函数，可是还是看不大懂这段代码的逻辑。
特此发帖求教高手们帮忙解读指导以下这段代码的意思。万分感些！！！

1. 
   
2. Sub 查询匹配()
   
3.     Dim arr, brr, crr, krr
   
4.     arr = Range("A4:C30")   
   
5.     brr = Range("F4:F19")   
   
6.     ReDim krr(1 To UBound(brr), 1 To 2)
   
7.     For i = 1 To UBound(brr)
   
8.         s = brr(i, 1)
   
9.         crr = Split(s, " ")
   
10.         For k = 1 To UBound(arr)
    
11.             L1 = 0: L2 = 0
    
12.             For j = 0 To UBound(crr)
    
13.                 If Len(crr(j)) > 0 Then
    
14.                     If InStr(1, arr(k, 2), crr(j), 1) > 0 Then L1 = L1 + 1   
    
15.                 End If
    
16.             Next
    
17.             If L1 >= 2 Then
    
18.                 krr(i, 1) = krr(i, 1) & "," & (k + 3)
    
19.                 krr(i, 2) = krr(i, 2) & ", " & arr(k, 1)
    
20.             Else
    
21.                 For j = 0 To UBound(crr)
    
22.                     If Len(crr(j)) > 0 Then
    
23.                         If InStr(1, arr(k, 3), crr(j), 1) > 0 Then L2 = L2 + 1   
    
24.                     End If
    
25.                 Next
    
26.                 If L2 >= 2 Then
    
27.                     krr(i, 1) = krr(i, 1) & "," & (k + 3)
    
28.                     krr(i, 2) = krr(i, 2) & ", " & arr(k, 1)
    
29.                 End If
    
30.             End If
    
31.         Next
    
32.         krr(i, 1) = "row: " & Mid(krr(i, 1), 2)
    
33.         krr(i, 2) = "'" & Mid(krr(i, 2), 3)
    
34.     Next
    
35.     Range("J4").Resize(UBound(krr), 2) = krr
    
36. End Sub

复制代码

最佳答案

月排行榜 / 总排行榜

zjdh

2014-9-15 10:56

Sub 查询匹配()
    Dim arr, brr, crr, krr
    arr = Range("A4:C30")
    brr = Range("F4:F19")
    ReDim krr(1 To UBound(brr), 1 To 2)
    For i = 1 To UBound(brr)
        s = brr(i, 1)
        crr = Split(s, " ")       '取出每个被比较的值
        For k = 1 To UBound(arr)  '对每个接受搜索的值比较
            L1 = 0: L2 = 0        '标识复原
            For j = 0 To UBound(crr)  '逐个搜索
                If Len(crr(j)) > 0 Then   '若值大于0
                    If InStr(1, arr(k, 2), crr(j), 1) > 0 Then L1 = L1 + 1  'B列含有被搜索值，则标识+1
                End If
            Next
            If L1 >= 2 Then                 '有2个及以上被比较的值时
                krr(i, 1) = krr(i, 1) & "," & (k + 3)     '记录行号
                krr(i, 2) = krr(i, 2) & ", " & arr(k, 1)  '记录A列内容
            Else
                For j = 0 To UBound(crr)  '逐个搜索
                    If Len(crr(j)) > 0 Then
                        If InStr(1, arr(k, 3), crr(j), 1) > 0 Then L2 = L2 + 1    'C列含有被搜索值，则标识+1
                    End If
                Next
                If L2 >= 2 Then                 '有2个及以上被比较的值时
                    krr(i, 1) = krr(i, 1) & "," & (k + 3)     '记录行号
                    krr(i, 2) = krr(i, 2) & ", " & arr(k, 1)  '记录A列内容
                End If
            End If
        Next
        krr(i, 1) = "row: " & Mid(krr(i, 1), 2)
        krr(i, 2) = "'" & Mid(krr(i, 2), 3)
    Next
    Range("J4").Resize(UBound(krr), 2) = krr
End Sub

跳转到最佳答案楼层

zjdh

Sub 查询匹配()
    Dim arr, brr, crr, krr
    arr = Range("A4:C30")
    brr = Range("F4:F19")
    ReDim krr(1 To UBound(brr), 1 To 2)
    For i = 1 To UBound(brr)
        s = brr(i, 1)
        crr = Split(s, " ")       '取出每个被比较的值
        For k = 1 To UBound(arr)  '对每个接受搜索的值比较
            L1 = 0: L2 = 0        '标识复原
            For j = 0 To UBound(crr)  '逐个搜索
                If Len(crr(j)) > 0 Then   '若值大于0
                    If InStr(1, arr(k, 2), crr(j), 1) > 0 Then L1 = L1 + 1  'B列含有被搜索值，则标识+1
                End If
            Next
            If L1 >= 2 Then                 '有2个及以上被比较的值时
                krr(i, 1) = krr(i, 1) & "," & (k + 3)     '记录行号
                krr(i, 2) = krr(i, 2) & ", " & arr(k, 1)  '记录A列内容
            Else
                For j = 0 To UBound(crr)  '逐个搜索
                    If Len(crr(j)) > 0 Then
                        If InStr(1, arr(k, 3), crr(j), 1) > 0 Then L2 = L2 + 1    'C列含有被搜索值，则标识+1
                    End If
                Next
                If L2 >= 2 Then                 '有2个及以上被比较的值时
                    krr(i, 1) = krr(i, 1) & "," & (k + 3)     '记录行号
                    krr(i, 2) = krr(i, 2) & ", " & arr(k, 1)  '记录A列内容
                End If
            End If
        Next
        krr(i, 1) = "row: " & Mid(krr(i, 1), 2)
        krr(i, 2) = "'" & Mid(krr(i, 2), 3)
    Next
    Range("J4").Resize(UBound(krr), 2) = krr
End Sub

su45

天啊，学函数与看代码不是一回事的！