Sub 工号匹配()
Dim arr, i, j, k, Strk
With Sheets("花名表")
endrow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
endcol = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Column
arr = Range(.Cells(1, 1), .Cells(endrow, endcol))
Set dic = CreateObject("scripting.dictionary")
For i = 1 To endrow
For j = 1 To endcol
If Left(arr(i, j), 1) = "T" Then
dic.Add arr(i + 1, j), arr(i, j)
End If
Next
Next
End With
For k = 2 To Sheets("查找表").Cells(Sheets("查找表").Rows.Count, "A").End(xlUp).Row
Strk = Sheets("查找表").Cells(k, 1)
If dic.Exists(Strk) Then
Sheets("查找表").Cells(k, 2) = dic.Item(Strk)
End If
Next
End Sub |