|
Sub 匹配()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("汇总跟踪")
.[a1].CurrentRegion.Offset(1) = Empty
ar = .Range("a1:z10000")
For j = 1 To UBound(ar, 2)
If Trim(ar(1, j)) <> "" Then
d(Trim(ar(1, j))) = j
End If
Next j
n = 1
For Each sh In Sheets
If sh.Index > 1 Then
br = sh.[a1].CurrentRegion
For i = 2 To UBound(br)
If Trim(br(i, 1)) <> "" Then
n = n + 1
For j = 1 To UBound(br, 2)
m = d(Trim(br(1, j)))
If m <> "" Then
ar(n, m) = br(i, j)
End If
Next j
End If
Next i
End If
Next sh
.[a1].Resize(n, UBound(ar, 2)) = ar
End With
MsgBox "ok!"
End Sub
|
|