请老师帮忙看一下这种竖转横的查找方法

blackttea1

谢谢分享！

准提部林

Sub TEST_A1()
Dim Arr, Brr, xD, T$, i&, j%
Set xD = CreateObject("scripting.dictionary")
With Sheet1
     If .FilterMode Then .ShowAllData
     Arr = Range(.[d1], .Cells(Rows.Count, 1).End(3))
     For i = 3 To UBound(Arr)
         xD(Arr(i, 1) & "|" & Arr(i, 2)) = Arr(i, 3)
         xD(Arr(i, 1) & "|" & Arr(2, 4)) = Arr(i, 4)
     Next i
End With
With Sheet2
     If .FilterMode Then .ShowAllData
     Arr = Range(.[g1], .Cells(Rows.Count, 1).End(3))
     ReDim Brr(1 To UBound(Arr) - 2, 1 To 6)
     For i = 3 To UBound(Arr)
         For j = 2 To 7
             T = Arr(i, 1) & "|" & Arr(2, j)
             If xD.exists(T) Then Brr(i - 2, j - 1) = xD(T)
         Next j
     Next i
     .[b3].Resize(UBound(Brr), 6) = Brr
End With
End Sub

笨鸟飞不高

特殊的查找.zip (104 KB, 下载次数: 5)

2021-8-10 11:22 上传

点击文件名下载附件

china047

笨鸟飞不高 发表于 2021-8-10 11:22

多谢 "笨鸟飞不高"