|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub test()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
ar = Sheet1.[a1].CurrentRegion
With Sheet2
r = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("c2:k" & r) = Empty
br = .Range("a1:k" & r)
For i = 2 To UBound(br)
If Trim(br(i, 2)) <> "" Then
d(Trim(br(i, 2))) = i
End If
Next i
For j = 3 To UBound(br, 2)
If Trim(br(1, j)) <> "" Then
d(Trim(br(1, j))) = j
End If
Next j
For i = 2 To UBound(ar)
If Trim(ar(i, 2)) <> "" Then
n = d(Trim(ar(i, 2)))
If n <> "" Then
For j = 1 To UBound(ar, 2)
m = d(Trim(ar(1, j)))
If m <> "" Then
br(n, m) = ar(i, j)
End If
Next j
End If
End If
Next i
.Range("a1:k" & r) = br
End With
MsgBox "ok!"
End Sub
|
|