多行多列转多行5列

 

Sub Main()
Set d = CreateObject("scripting.dictionary")
arr = ActiveSheet.Range("a1").CurrentRegion
For x = 2 To UBound(arr)
d(arr(x, 2)) = arr(x, 3)
Next
arritem = d.items
arrkey = d.keys
k = 15
For x = 0 To UBound(arrkey)
k = k + 1
If k Mod 5 = 1 Then n = n + 2: k = k - 5
Cells(n, k) = arrkey(x)
Cells(n + 1, k) = arritem(x)
Next
End Sub