|
Sub test()
Dim i As Long
Dim ar As Variant
Dim d As Object
Dim br()
Set d = CreateObject("scripting.dictionary")
ar = Range("a1").CurrentRegion
ReDim br(1 To UBound(ar) * 3, 1 To UBound(ar, 2) + 1)
For i = 2 To UBound(ar)
If i < 5 Then
n = n + 1
For j = 1 To UBound(ar, 2)
br(n, j + 1) = ar(i, j)
Next j
Else
d.RemoveAll
If ar(i, 1) <> "" Then
For j = 2 To UBound(ar, 2)
If ar(i, j) <> Empty Then
If d(ar(i, j)) = "" Then
d(ar(i, j)) = j
Else
d(ar(i, j)) = d(ar(i, j)) & "|" & j
End If
End If
Next j
For Each k In d.keys
n = n + 1
br(n, 1) = ar(i, 1)
br(n, 2) = k
rr = Split(d(k), "|")
For s = 0 To UBound(rr)
lh = rr(s)
br(n, lh + 1) = ar(3, lh)
Next s
Next k
End If
End If
Next i
Range("j1").CurrentRegion.Offset(1).ClearContents
Range("j2").Resize(n, UBound(br, 2)) = br
MsgBox "ok!"
End Sub |
|