Excel VBA程序开发

Jerry6455 Lv.2

2024-2-27 14:41 关注
求大神们，我想要在A和B表中数据关联，求高级筛选出A和B中指定的商品编码


Book1.zip   2024-2-27 14:41 上传

10.76 KB, 下载次数: 15

赏
408阅读
9回复 倒序

shiruiqiang Lv.6 2楼

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

Jerry6455 楼主 3楼

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

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

tanglf188 Lv.4 4楼

2024-2-27 16:56
请参考
image.png

Book1.rar   2024-2-27 16:56 上传

25.2 KB, 下载次数: 12

洋务德雷 Lv.4 5楼

2024-2-27 17:16
。。。。。。。

Book1.zip   2024-2-27 17:16 上传

29.2 KB, 下载次数: 9

Jerry6455 楼主 6楼

2024-2-28 08:06
引用: 洋务德雷 发表于 2024-2-27 17:16
。。。。。。。

谢谢，感谢大神们的

ykcbf1100 Lv.7 7楼

2024-2-28 16:42
本帖最后由 ykcbf1100 于 2024-2-28 16:53 编辑


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

Book2.zip   2024-2-28 16:42 上传

21.7 KB, 下载次数: 3

ykcbf1100 Lv.7 8楼

2024-2-28 16:43
参与一下。。。
  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 Lv.7 9楼

2024-2-28 16:51
改用字典再写一个。

Book3.7z   2024-2-28 16:51 上传

23.42 KB, 下载次数: 3

ykcbf1100 Lv.7 10楼

2024-2-28 16:52
参与一下。
  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


已显示全部内容

高级模式
插入