Sub 转置()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheet1
x = .Cells(Rows.Count, 1).End(xlUp).Row
y = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 3), .Cells(x, y)) = Empty
ar = .Range(.Cells(1, 1), .Cells(x, y))
For i = 2 To UBound(ar)
If Len(Trim(ar(i, 1))) <> 0 And Len(Trim(ar(i, 2))) <> 0 Then
s = Trim(ar(i, 1)) & "|" & Trim(ar(i, 2))
d(s) = i
End If
Next i
For j = 3 To UBound(ar, 2)
If Trim(ar(1, j)) <> "" Then
d(Trim(ar(1, j))) = j
End If
Next j
br = Sheet2.[a1].CurrentRegion
For i = 2 To UBound(br)
s_1 = Trim(br(i, 1)) & "|" & Trim(br(i, 2))
n = d(s_1)
m = d(Trim(br(i, 4)))
If n <> "" And m <> "" Then
ar(n, m) = br(i, 3)
End If
Next i
.Range(.Cells(1, 1), .Cells(x, y)) = ar
End With
MsgBox "ok!"
End Sub
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2020-2-27 09:00
楼主
