把符合条件的数据标出来

cysczhumh

当A列数据和E列相同时，把F、G、H列对应的数据在B、C、D列中表示出来。

醉眼看尘世

Sub a1() '把A列包含在B列中的数据标出来,按钢瓶号
Dim Arr, i&, hS&, Dic As Object, Brr, tmPstr$
Set Dic = CreateObject("scripting.dictionary")
Dic.comparemode = vbTextCompare
With ActiveSheet
    hS = .Cells(.Rows.Count, "E").End(3).Row
    Arr = .[e1].Resize(hS, 4)
    For i = 2 To UBound(Arr, 1)
        Dic(Arr(i, 1) & "") = i
    Next i
   
    hS = .Cells(.Rows.Count, "A").End(3).Row
    Brr = .[a2].Resize(hS - 1, 4)
    For i = 1 To UBound(Brr, 1)
        tmPstr = Brr(i, 1) & ""
        If Dic.exists(tmPstr) Then
            hS = Dic(tmPstr)
            For j = 2 To UBound(Arr, 2)
                Brr(i, j) = Arr(hS, j)
            Next j
        End If
    Next i
   
    .[a2].Resize(UBound(Brr, 1), UBound(Brr, 2)) = Brr
End With
End Sub

醉眼看尘世

记得预先设置结果区域的数据格式，与源区域一致

shiruiqiang

vlookup，index
数组对比，字典，sql

quqiyuan

这个用个简单公式就好了，仅供参考。。。
=VLOOKUP($A2,$E:$H,COLUMN(B1),)

ykcbf1100

典型的字典一查多。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.7.27
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     r = Cells(Rows.Count, 5).End(3).Row
   
4.     arr = [e1].Resize(r, 4)
   
5.     For i = 2 To UBound(arr)
   
6.         s = CStr(arr(i, 1))
   
7.         If Not d.exists(s) Then
   
8.             d(s) = i
   
9.         End If
   
10.     Next
    
11.     r = Cells(Rows.Count, 1).End(3).Row
    
12.     For i = 2 To UBound(arr)
    
13.         s = CStr(Cells(i, 1))
    
14.         If d.exists(s) Then
    
15.             For j = 2 To 4
    
16.                 Cells(i, j) = arr(d(s), j)
    
17.             Next
    
18.         End If
    
19.     Next
    
20.     MsgBox "OK！"
    
21. End Sub
    

复制代码

cysczhumh

ykcbf1100 发表于 2024-7-27 20:20
典型的字典一查多。

结果非常正确，是运行最快的方法，谢谢。

zhangcheng6688

学习一下字典，打扰了
Sub test()
arr = Range("a1").CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
   d(arr(i, 5)) = i
Next
For i = 2 To UBound(arr)
   If arr(i, 1) <> "" Then
      r = d(arr(i, 1))
      For j = 1 To 3
         arr(i, j + 1) = arr(r, j + 5)
      Next
   End If
Next
Range("a1").CurrentRegion = arr
End Sub

沈默00

B2=XLOOKUP($A$2:$A$1582,$E:$E,F:F)  右拉、下拉，
或是FILTER也可以