求写一个VBA代码匹配出多个值

glenstyle

求写一个VBA代码匹配出订单号，存在以下特殊情形：
1、第三方号可能会匹配出多个订单号（VLOOKUP只能匹配出第一个，不适用），这个可能要看车牌号和金额。
2、订单号在源数据表格是唯一值，但是在匹配项这里可能重复出现，金额会被拆分，如170元，在匹配表里，会出现两个85元。
3、要保证匹配项匹配出来的订单号金额合计=源数据的订单号金额合计

ykcbf1100

用字典就行。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.7.30
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("源数据")
   
6.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
   
7.         arr = .[a1].Resize(r, 4)
   
8.     End With
   
9.     For i = 2 To UBound(arr)
   
10.         s = arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4)
    
11.         d(s) = arr(i, 1)
    
12.     Next
    
13.     With Sheets("匹配项")
    
14.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
    
15.         arr = .[a1].Resize(r, 4)
    
16.         For i = 2 To UBound(arr)
    
17.             s = arr(i, 3) & "|" & arr(i, 1) & "|" & arr(i, 2)
    
18.             If d.Exists(s) Then
    
19.                 arr(i, 4) = d(s)
    
20.             End If
    
21.         Next
    
22.         .[d1].Resize(r, 1) = Application.Index(arr, 0, 4)
    
23.     End With
    
24.     Set d = Nothing
    
25.     Application.ScreenUpdating = True
    
26.     MsgBox "OK！"
    
27. End Sub
    

复制代码

quqiyuan

参与一下，进过参考。。。

quqiyuan

代码如下。。。
Sub test()
    Set d = CreateObject("scripting.dictionary")
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("源数据")
    Set sh = wb.Sheets("匹配项")
    arr = sht.[a1].CurrentRegion
    brr = sh.[a1].CurrentRegion
    ReDim crr(1 To UBound(brr), 1 To 1)
    For i = 2 To UBound(arr)
        s = arr(i, 2) & arr(i, 3)
        If Not d.exists(s) Then
            d(s) = arr(i, 1)
        End If
    Next
    For i = 2 To UBound(brr)
        s = brr(i, 3) & brr(i, 1)
        If d.exists(s) Then
            crr(i, 1) = d(s)
        End If
    Next
    Set d = Nothing
    sh.[d1].Resize(UBound(crr), 1) = crr
    sh.[d1] = "订单号"
    Beep
End Sub

quqiyuan

这个表格其实有些重复的，用公式筛选也可以做出来，字典反而不行，要从新写，算了，公式还一目了然

=INDEX(FILTER(源数据!A:A,(A2=源数据!C:C)*(源数据!B:B=C2),""),COUNTIFS(A$2:A2,A2,C$2:C2,C2&"*"))
下拉