比对尾后提数据

ddz79101

老师！有2张表，我希望依据单元格中尾部发票号，提取2表相关信息到对方表。此处发票号一般为8位数，但在关键字考虑时，最好是考虑后7位，请老师帮忙

ykcbf1100

参与一下。。。

1. Sub ykcbf() '//2024.1.16
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Set d1 = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("比2")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         arr = .Range("a1:f" & r)
   
7.         For i = 2 To UBound(arr)
   
8.             s = CStr(arr(i, 4))
   
9.             d(s) = arr(i, 6)
   
10.         Next
    
11.     End With
    
12.     Set reg = CreateObject("VBScript.RegExp")
    
13.     On Error Resume Next
    
14.     With Sheets("比1")
    
15.         r = .Cells(Rows.Count, 1).End(3).Row
    
16.         arr = .Range("a1:g" & r)
    
17.         For i = 2 To UBound(arr)
    
18.             st = arr(i, 4)
    
19.             With reg
    
20.                 .Pattern = "(\d+)$"
    
21.             End With
    
22.             Set mh = reg.Execute(st)
    
23.             If mh.Count > 0 Then
    
24.                 s = mh(0).Value
    
25.             Else
    
26.                 s = ""
    
27.             End If
    
28.             If Not d1.exists(s) Then
    
29.                 d1(s) = Array(arr(i, 1), arr(i, 2), arr(i, 3))
    
30.             End If
    
31.             If d.exists(s) Then
    
32.                 arr(i, 7) = d(s)
    
33.             End If
    
34.         Next
    
35.         .Range("a1:g" & r) = arr
    
36.     End With
    
37.     With Sheets("比2")
    
38.         r = .Cells(Rows.Count, 1).End(3).Row
    
39.         arr = .Range("a1:j" & r)
    
40.         For i = 2 To UBound(arr)
    
41.             s = CStr(arr(i, 4))
    
42.             For j = 8 To UBound(arr, 2)
    
43.                 arr(i, j) = d1(s)(j - 8)
    
44.             Next
    
45.         Next
    
46.         .Range("a1:j" & r) = arr
    
47.     End With
    
48.     Set d = Nothing
    
49.     Set d1 = Nothing
    
50.     MsgBox "二表数据提取完成！"
    
51. End Sub
    
52. 
    

复制代码

ykcbf1100

附件供参考。。。

ddz79101

ykcbf1100 发表于 2024-1-16 20:18
附件供参考。。。

谢谢老师！运行正确！

ykcbf1100

ddz79101 发表于 2024-1-16 20:26
谢谢老师！运行正确！

提取尾部发票号用的是正则表达式。

ddz79101

ykcbf1100 发表于 2024-1-16 20:18
附件供参考。。。

谢谢老师！运行成功