VBA多条件模糊查找匹配

Lisianthus1

请问用图一黄色的两个条件，将蓝色对应的数字匹配到图二橙色区域，但是黄色的条件跟图二不完全一致，怎么写能匹配到and保证准确性呢？

Lisianthus1

天天学习 天天向上

ykcbf1100

不完全一致是什么意思？

Qs18

不完全一致就不能保证准确性

Lisianthus1

ykcbf1100 发表于 2024-6-28 15:59
不完全一致是什么意思？

就是两张图的订单号 有的会有后缀

ykcbf1100

参与一下。。。

注意：文件２才是主工作簿

ykcbf1100

参与一下，猜一个。

1. Sub ykcbf()   '//2024.6.28
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
5.     p = ThisWorkbook.Path
   
6.     f = p & "\1.xls"
   
7.     Set wb = Workbooks.Open(f, 0)
   
8.     With wb.Sheets("Sheet1")
   
9.         arr = .UsedRange
   
10.         wb.Close 0
    
11.     End With
    
12.     For i = 2 To UBound(arr)
    
13.         s = arr(i, 2) & "|" & arr(i, 6)
    
14.         d(s) = arr(i, 12)
    
15.     Next
    
16.     With sh
    
17.         r = .Cells(Rows.Count, 1).End(3).Row
    
18.         For i = 2 To r
    
19.             s = .Cells(i, 1) & "|" & .Cells(i, 2)
    
20.             If d.exists(s) Then
    
21.                 .Cells(i, 3) = d(s)
    
22.             Else
    
23.                 .Cells(i, 3) = ""
    
24.             End If
    
25.         Next
    
26.     End With
    
27.     Set d = Nothing
    
28.     Application.ScreenUpdating = True
    
29.     MsgBox "OK！"
    
30. End Sub
    

复制代码

ykcbf1100

Lisianthus1 发表于 2024-6-28 16:04
就是两张图的订单号 有的会有后缀

说话一次性说清楚啊。
你的意思是订单号只用前面部分比对？

ykcbf1100

Lisianthus1 发表于 2024-6-28 16:04
就是两张图的订单号 有的会有后缀

好吧，我想你是这个意思吧。
只有一个匹配不到。

ykcbf1100

模糊匹配。订单号表１包含表２的情况。

1. Sub ykcbf()   '//2024.6.28
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
5.     p = ThisWorkbook.Path
   
6.     f = p & "\1.xls"
   
7.     Set wb = Workbooks.Open(f, 0)
   
8.     With wb.Sheets("Sheet1")
   
9.         arr = .UsedRange
   
10.         wb.Close 0
    
11.     End With
    
12.     For i = 2 To UBound(arr)
    
13.         s = arr(i, 2) & "|" & arr(i, 6)
    
14.         d(s) = arr(i, 12)
    
15.     Next
    
16.     With sh
    
17.         r = .Cells(Rows.Count, 1).End(3).Row
    
18.         For i = 2 To r
    
19.             s = .Cells(i, 1) & "|" & .Cells(i, 2)
    
20.             For Each k In d.keys
    
21.                 If InStr(k, .Cells(i, 2)) Then
    
22.                     If InStr(k, .Cells(i, 1)) Then
    
23.                         .Cells(i, 3) = d(k)
    
24.                         Exit For
    
25.                     End If
    
26.                 End If
    
27.             Next
    
28.         Next
    
29.     End With
    
30.     Set d = Nothing
    
31.     Application.ScreenUpdating = True
    
32.     MsgBox "OK！"
    
33. End Sub
    
34. 
    

复制代码