|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Option Explicit
Dim sh As Worksheet, sht As Worksheet
Sub my_find(sh As Worksheet, rg As Range, sht As Worksheet, rng As Range)
Dim ar, d As Object, i&, s$
ar = rg.Value
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(ar)
s = ar(i, 1)
If s <> "" Then
d(s) = ar(i, 6) & "," & ar(i, 7) & "," & ar(i, 8)
End If
Next
If d.Count = 0 Then End
Erase ar
ar = rng
For i = 2 To UBound(ar)
s = ar(i, 1)
If d.exists(s) Then
ar(i, 9) = Split(d(s), ",")(0)
ar(i, 10) = Split(d(s), ",")(1)
ar(i, 11) = Split(d(s), ",")(2)
End If
Next
rng = ar
With sht.UsedRange
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.EntireColumn.AutoFit
End With
End Sub
Sub 查找()
Dim i&, m&
Set sh = ThisWorkbook.Sheets("表1")
Set sht = ThisWorkbook.Sheets("表2")
i = sh.Range("a" & sh.Rows.Count).End(xlUp).Row
m = sht.Range("c" & sht.Rows.Count).End(xlUp).Row
my_find sh, sh.Range("a1").Resize(i, 8), sht, sht.Range("c1").Resize(m, 11)
End Sub
|
|