A和B表关联筛选出指定数据

Jerry6455

求大神们，我想要在A和B表中数据关联，求高级筛选出A和B中指定的商品编码

shiruiqiang

你怎么关联，数据模拟的详细一点。至少不要让别人猜啊

Jerry6455

shiruiqiang 发表于 2024-2-27 15:50
你怎么关联，数据模拟的详细一点。至少不要让别人猜啊

有表啊，在A和B中输入指定的编号筛选出来结果

tanglf188

请参考

洋务德雷

。。。。。。。

Jerry6455

洋务德雷 发表于 2024-2-27 17:16
。。。。。。。

谢谢，感谢大神们的

ykcbf1100

用ArrayList写一个。
附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.2.28
   
2.     Set List = CreateObject("System.Collections.ArrayList")
   
3.     Set sh = ThisWorkbook.Sheets("筛选出A和B中多个相同的编码筛选出来")
   
4.     fns = [{"A", "B"}]
   
5.     On Error Resume Next
   
6.     With sh
   
7.         b = Split(.Cells(2, 2), "、")
   
8.         For i = 0 To UBound(b)
   
9.             s = b(i)
   
10.             If Not List.Contains(s) Then List.Add s
    
11.         Next
    
12.         b = Split(.Cells(2, 4), "、")
    
13.         For i = 0 To UBound(b)
    
14.             s = b(i)
    
15.             If Not List.Contains(s) Then List.Add s
    
16.         Next
    
17.     End With
    
18.     List.Sort
    
19.     ReDim brr(1 To 10000, 1 To 6)
    
20.     For x = 1 To 2
    
21.         With Sheets(fns(x))
    
22.             arr = .UsedRange
    
23.             For i = 3 To UBound(arr)
    
24.                 s = CStr(arr(i, 1))
    
25.                 For Each k In List
    
26.                     If s = k Then
    
27.                         m = m + 1
    
28.                         For j = 1 To UBound(arr, 2)
    
29.                             brr(m, j) = arr(i, j)
    
30.                         Next
    
31.                     End If
    
32.                 Next
    
33.             Next
    
34.         End With
    
35.     Next
    
36.     With sh
    
37.         .UsedRange.Offset(4) = ""
    
38.         .[a5].Resize(m, 6) = brr
    
39.         .[a5].Resize(m, 6).Sort .[a5], 1
    
40.         .[a5].Resize(m, 6).Borders.LineStyle = 1
    
41.         .[a4].Resize(1, 6).Interior.Color = 49407
    
42.     End With
    
43.     MsgBox "OK！"
    
44. End Sub
    

复制代码

ykcbf1100

改用字典再写一个。

ykcbf1100

参与一下。

1. Sub ykcbf2()  '//2024.2.28
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Set sh = ThisWorkbook.Sheets("筛选出A和B中多个相同的编码筛选出来")
   
4.     fns = [{"A", "B"}]
   
5.     On Error Resume Next
   
6.     st = ""
   
7.     st = sh.Cells(2, 2) & "、" & sh.Cells(2, 4)
   
8.     ar = Split(st, "、")
   
9.     For i = 0 To UBound(ar)
   
10.         d(ar(i)) = ""
    
11.     Next
    
12.     ReDim brr(1 To 10000, 1 To 6)
    
13.     For x = 1 To 2
    
14.         With Sheets(fns(x))
    
15.             arr = .UsedRange
    
16.             For i = 3 To UBound(arr)
    
17.                 s = CStr(arr(i, 1))
    
18.                 For Each k In d.keys
    
19.                     If s = k Then
    
20.                         m = m + 1
    
21.                         For j = 1 To UBound(arr, 2)
    
22.                             brr(m, j) = arr(i, j)
    
23.                         Next
    
24.                     End If
    
25.                 Next
    
26.             Next
    
27.         End With
    
28.     Next
    
29.     With sh
    
30.         .UsedRange.Offset(4) = ""
    
31.         .[a5].Resize(m, 6) = brr
    
32.         .[a5].Resize(m, 6).Sort .[a5], 1
    
33.         .[a5].Resize(m, 6).Borders.LineStyle = 1
    
34.         .[a4].Resize(1, 6).Interior.Color = 49407
    
35.     End With
    
36.     MsgBox "OK！"
    
37. End Sub
    

复制代码