求大神帮忙写一段两列数据对比的代码

JIUYINI

对比B列和C列数据，结果显示在E列

醉眼看尘世

1. Sub test()
   
2. Dim Arr, NextStr$, i&, j&, tmPstr$, Dic As Object, Trr
   
3. Set Dic = CreateObject("scripting.dictionary")
   
4. With Sheet1
   
5.     i = .Cells(.Rows.Count, "C").End(3).Row
   
6.     Arr = .[c5].Resize(i - 4, 1)
   
7.    
   
8.     NextStr = .[b5]
   
9.     Trr = Split(NextStr, ",")
   
10.     For j = 0 To UBound(Trr)
    
11.         Dic(Trr(j)) = ""
    
12.     Next j
    
13.    
    
14.     ReDim Brr(1 To UBound(Arr, 1), 1 To 1)
    
15.     For i = 1 To UBound(Arr, 1)
    
16.         tmPstr = ""
    
17.         Trr = Split(Arr(i, 1), ",")
    
18.         For j = 0 To UBound(Trr)
    
19.             If Dic.exists(Trr(j)) Then tmPstr = tmPstr & Trr(j) & ","
    
20.         Next j
    
21.         If tmPstr <> "" Then Brr(i, 1) = Left(tmPstr, Len(tmPstr) - 1)
    
22.     Next i
    
23.     .[E5].Resize(UBound(Brr, 1), 1).NumberFormat = "@"
    
24.     .[E5].Resize(UBound(Brr, 1), 1) = Brr
    
25. End With
    
26. End Sub

复制代码

ykcbf1100

练个手。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.8.23
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     r = Cells(Rows.Count, 1).End(3).Row
   
4.     [e5].Resize(r - 4, 1) = ""
   
5.     arr = [a5].Resize(r - 4, 5)
   
6.     For i = 1 To UBound(arr)
   
7.         d.RemoveAll
   
8.         st1 = Split(arr(i, 2), ",")
   
9.         For x = LBound(st1) To UBound(st1)
   
10.             d(st1(x)) = st1(x)
    
11.         Next
    
12.         st2 = Split(arr(i, 3), ",")
    
13.         st = ""
    
14.         For x = LBound(st2) To UBound(st2)
    
15.             s = st2(x)
    
16.             If d.exists(s) Then
    
17.                 st = st & "," & st2(x)
    
18.             End If
    
19.         Next
    
20.         arr(i, 5) = Mid(st, 2)
    
21.     Next
    
22.     [e5].Resize(r - 4, 1) = Application.Index(arr, 0, 5)
    
23.     MsgBox "OK！"
    
24. End Sub
    

复制代码

笨鸟飞不高

一招秒杀

1句全搞定，除了图中模拟的数据，剩下的代码是不是比楼上的都要简单太多太多

rysxing

试试。。。。。。