vba match+index 函数查找出错求帮助

xhc陈

vba match+index 函数查找出错求帮助，见附件。

汉唐

既然用了vba ，就尽量不要用函数公式。
Sub test()
Dim i As Long, j As Integer, r As Long, n As Long
Dim arr1, arr2, s
With Sheet1
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr1 = .Cells(1, 1).Resize(r, 5)
r = .Cells(.Rows.Count, 9).End(xlUp).Row
arr2 = .Cells(1, 9).Resize(r, 5)
End With
For i = 2 To UBound(arr2)
s = arr2(i, 1)
For x = 2 To UBound(arr1)
If arr1(x, 1) = s Then
For j = 2 To 5
arr2(i, j) = arr1(x, j)
Next 'j
Exit For
End If
Next 'x
Next 'i
Cells(1, 9).Resize(UBound(arr2), 5) = arr2
End Sub

汉唐

请参考附件。。

xhc陈

汉唐 发表于 2022-12-25 20:21
请参考附件。。

我的本意是希望能够找出match函数出错的原因，不过还是感谢！

汉唐

9+i应该改为9+j

松野

1. Sub 查找数据()
   
2. Dim xmrr(), xkrr(), jgrr()
   
3. With Sheets("sheet1")
   
4. .Activate
   
5.     hs = .[a1].CurrentRegion.Rows.Count
   
6.     ls = .[a1].CurrentRegion.Columns.Count
   
7.    Set zbrr = Range(.Cells(2, 2), .Cells(hs, ls))
   
8.    
   
9.     jghs = [i1].CurrentRegion.Rows.Count
   
10.     jgls = [i1].CurrentRegion.Columns.Count
    
11.    
    
12.     ReDim jgrr(1 To jghs - 1, 1 To jgls - 1)
    
13.             For i = 1 To jghs - 1
    
14.             czhs = Application.Match(.Cells(i + 1, 9), Range("a2:a" & hs), 0)
    
15.             For j = 1 To jgls - 1
    
16.            
    
17.             czls = Application.Match(.Cells(1, 9 + j), Range("b1:e1"), 0)
    
18. 
    
19.             jgrr(i, j) = Application.Index(Range(.Cells(2, 2), .Cells(hs, ls)), czhs, czls)
    
20.             Next j
    
21.         Next i
    
22.         [j2].Resize(jghs - 1, jgls - 1) = jgrr
    
23.    
    
24.    
    
25. 
    
26. End With
    
27. End Sub

复制代码

楼主代码有错。。。而且，mathc要加0，完全匹配

松野

用字典一对多匹配就OK 了，附上通用的写法，匹配几十万行也很快，数据量大千万要用数组加字典，不然卡的要死。
Sub 字典一对多多多多匹配方法()
Dim i, j As Long
Dim arr, brr, crr, drr
Dim Str As String
Dim d As Object
Set d = CreateObject("scripting.dictionary")
arr = Sheet1.Range("a1").CurrentRegion
brr = Sheet1.Range("i2:i" & Sheet1.Range("i65536").End(xlUp).Row)
For i = 1 To UBound(arr)
    crr = Cells(i, 2).Resize(1, 4)
    crr = Application.Transpose(Application.Transpose(crr))
    Str = Join(crr, "|")
    If Not d.exists(arr(i, 1)) Then
        d(arr(i, 1)) = Str
    End If
Next

ReDim drr(1 To UBound(brr), 1 To 4)
For i = 1 To UBound(brr)
    For j = 1 To 4
        If d.exists(brr(i, 1)) Then
            drr(i, j) = Split(d(brr(i, 1)), "|")(j - 1)
        End If
    Next
Next
Sheet1.Range("j2").Resize(UBound(brr), 4) = drr
End Sub

松野

nicleyuan

nicleyuan