反向转置将行解除连接到列
我在Excel中有以下macros来采取这样的两列
Client | Product 12 | A 12 | B 12 | C 15 | A 15 | C 并转置连接成
Client | Product 12 | A,B,C 15 | A,C
现在我想创build一个excelmacros，做相反的事情，并采取这样的两列，反向转置un-concatenates他们进入
Client | Product 12 | A 12 | B 12 | C 15 | A 15 | C
我尝试了文本到列function，但它创build了这个
Client | Product 12 | A |B |C 15 | A |C
这是macros观的：
Sub Transpose2Columns() 'Takes 2 columns in a many to one relationship where 'Column A = one 'Column B = many 'De duplicates Column A and concatenates all values of Column B Dim StartRow As Long Dim EndRow As Long Dim LastRow As Long Dim CopyRange As Range Dim RightRow As Long Dim i As Long LastRow = Range("A65536").End(xlUp).Row RightRow = Range("AA1").End(xlToLeft).Column StartRow = 2 EndRow = 2 i = 2 j = 2 'Range(Cells(1, 1), Cells(LastRow, RightRow)).Sort Key1:=[A2], order1:=1, Header:=xlYes, key2:=[B2], order2:=1, Header:=xlYes Cells(1, RightRow + 3) = "One" Cells(1, RightRow + 4) = "Many" Cells(2, 1).Activate Do While ActiveCell <> "" If ActiveCell.Offset(1, 0) = ActiveCell.Offset(0, 0) Then ActiveCell.Offset(0, 2).FormulaR1C1 = ActiveCell.Offset(0, 1) & "; " Else ActiveCell.Offset(0, 2).FormulaR1C1 = ActiveCell.Offset(0, 1) End If ActiveCell.Offset(1, 0).Select Loop Do While StartRow <> LastRow + 1 Do While Cells(StartRow, 1).Value = Cells(EndRow, 1) EndRow = EndRow + 1 Loop With ActiveSheet .Range(Cells(StartRow, 3), Cells(EndRow - 1, 3)).Copy .Cells(i, RightRow + 5).PasteSpecial xlPasteValues, Transpose:=True .Cells(StartRow, 1).Copy Destination:=Cells(i, RightRow + 3) End With i = i + 1 StartRow = EndRow Loop Do While j < i Cells(j, RightRow + 4).FormulaR1C1 = Cells(j, RightRow + 4).Offset(0, 1) & Cells(j, RightRow + 4).Offset(0, 2) & Cells(j, RightRow + 4).Offset(0, 3) & Cells(j, RightRow + 4).Offset(0, 4) & Cells(j, RightRow + 4).Offset(0, 5) & Cells(j, RightRow + 4).Offset(0, 6) & Cells(j, RightRow + 4).Offset(0, 7) & Cells(j, RightRow + 4).Offset(0, 8) & Cells(j, RightRow + 4).Offset(0, 9) & Cells(j, RightRow + 4).Offset(0, 10) & Cells(j, RightRow + 4).Offset(0, 11) & Cells(j, RightRow + 4).Offset(0, 12) & Cells(j, RightRow + 4).Offset(0, 13) & Cells(j, RightRow + 4).Offset(0, 14) & Cells(j, RightRow + 4).Offset(0, 15) & Cells(j, RightRow + 4).Offset(0, 16) & Cells(j, RightRow + 4).Offset(0, 17) & Cells(j, RightRow + 4).Offset(0, 18) & Cells(j, RightRow + 4).Offset(0, 19) & Cells(j, RightRow + 4).Offset(0, 20) & Cells(j, RightRow + 4).Offset(0, 21) & Cells(j, RightRow + 4).Offset(0, 22) & Cells(j, RightRow + 4).Offset(0, 23) & Cells(j, RightRow + 4).Offset(0, 24) & Cells(j, RightRow + 4).Offset(0, 25) _ & Cells(j, RightRow + 4).Offset(0, 26) & Cells(j, RightRow + 4).Offset(0, 27) & Cells(j, RightRow + 4).Offset(0, 28) & Cells(j, RightRow + 4).Offset(0, 29) & Cells(j, RightRow + 4).Offset(0, 30) _ & Cells(j, RightRow + 4).Offset(0, 31) & Cells(j, RightRow + 4).Offset(0, 32) & Cells(j, RightRow + 4).Offset(0, 33) & Cells(j, RightRow + 4).Offset(0, 34) & Cells(j, RightRow + 4).Offset(0, 35) & Cells(j, RightRow + 4).Offset(0, 36) & Cells(j, RightRow + 4).Offset(0, 37) & Cells(j, RightRow + 4).Offset(0, 38) & Cells(j, RightRow + 4).Offset(0, 39) & Cells(j, RightRow + 4).Offset(0, 40) & Cells(j, RightRow + 4).Offset(0, 41) & Cells(j, RightRow + 4).Offset(0, 42) & Cells(j, RightRow + 4).Offset(0, 43) & Cells(j, RightRow + 4).Offset(0, 44) & Cells(j, RightRow + 4).Offset(0, 45) & Cells(j, RightRow + 4).Offset(0, 46) & Cells(j, RightRow + 4).Offset(0, 47) & Cells(j, RightRow + 4).Offset(0, 48) & Cells(j, RightRow + 4).Offset(0, 49) & Cells(j, RightRow + 4).Offset(0, 50) & Cells(j, RightRow + 4).Offset(0, 51) & Cells(j, RightRow + 4).Offset(0, 52) & Cells(j, RightRow + 4).Offset(0, 53) & Cells(j, RightRow + 4).Offset(0, 54) & Cells(j, RightRow + 4).Offset(0, 55) & Cells(j, RightRow + 4).Offset(0, 56) _ & Cells(j, RightRow + 4).Offset(0, 57) & Cells(j, RightRow + 4).Offset(0, 58) & Cells(j, RightRow + 4).Offset(0, 59) & Cells(j, RightRow + 4).Offset(0, 60) & Cells(j, RightRow + 4).Offset(0, 61) & Cells(j, RightRow + 4).Offset(0, 62) & Cells(j, RightRow + 4).Offset(0, 63) & Cells(j, RightRow + 4).Offset(0, 64) & Cells(j, RightRow + 4).Offset(0, 65) & Cells(j, RightRow + 4).Offset(0, 66) & Cells(j, RightRow + 4).Offset(0, 67) & Cells(j, RightRow + 4).Offset(0, 68) & Cells(j, RightRow + 4).Offset(0, 69) & Cells(j, RightRow + 4).Offset(0, 70) & Cells(j, RightRow + 4).Offset(0, 71) & Cells(j, RightRow + 4).Offset(0, 72) & Cells(j, RightRow + 4).Offset(0, 73) & Cells(j, RightRow + 4).Offset(0, 74) & Cells(j, RightRow + 4).Offset(0, 75) & Cells(j, RightRow + 4).Offset(0, 76) & Cells(j, RightRow + 4).Offset(0, 77) & Cells(j, RightRow + 4).Offset(0, 78) & Cells(j, RightRow + 4).Offset(0, 79) & Cells(j, RightRow + 4).Offset(0, 80) & Cells(j, RightRow + 4).Offset(0, 81) & Cells(j, RightRow + 4).Offset(0, 82) _ & Cells(j, RightRow + 4).Offset(0, 83) & Cells(j, RightRow + 4).Offset(0, 84) & Cells(j, RightRow + 4).Offset(0, 85) & Cells(j, RightRow + 4).Offset(0, 86) & Cells(j, RightRow + 4).Offset(0, 87) & Cells(j, RightRow + 4).Offset(0, 88) & Cells(j, RightRow + 4).Offset(0, 89) & Cells(j, RightRow + 4).Offset(0, 90) & Cells(j, RightRow + 4).Offset(0, 91) & Cells(j, RightRow + 4).Offset(0, 92) & Cells(j, RightRow + 4).Offset(0, 93) & Cells(j, RightRow + 4).Offset(0, 94) & Cells(j, RightRow + 4).Offset(0, 95) & Cells(j, RightRow + 4).Offset(0, 96) & Cells(j, RightRow + 4).Offset(0, 97) & Cells(j, RightRow + 4).Offset(0, 98) & Cells(j, RightRow + 4).Offset(0, 99) & Cells(j, RightRow + 4).Offset(0, 100) j = j + 1 Loop Columns("D:D").ColumnWidth = 9 Columns("E:E").ColumnWidth = 15 Columns("F:F").ColumnWidth = 35 Range(Cells(2, RightRow + 5), Cells(LastRow, RightRow + 50)).Clear Range(Cells(1, RightRow + 1), Cells(LastRow, RightRow + 1)).Clear Cells(1, RightRow + 2).Activate End Sub
一旦你有这个结果，你可以运行我的Unpivot加载项转换回你想要的输出
INPUT：
Client | Product 12 | A |B |C 15 | A |C
OUTPUT
Client | Product 12 | A 12 | B 12 | C 15 | A 15 | C
您可以在此处下载加载项，在启动之前select您的第一个产品代码（本例中为“A”）。
你可以把这个弄得一团糟 整理数组的大小，如果你需要：
Public Function paintRows(arr As Variant, arrRow As Long, i As Long, coll As Collection) As Long Dim newRows as Long, factor as Long, paint as Long newRows = 1 For Each c In coll newRows = newRows * (UBound(c) + 1) Next c factor = newRows For n = 1 To UBound(arr, 2) c = coll.Item(CStr(n)) u = UBound(c) factor = factor / (u + 1) For paint = arrRow To arrRow + newRows - 1 ind = ((paint - arrRow) \ factor) Mod (u + 1) arr(paint, n) = Trim(c(ind)) Next paint Next n paintRows = newRows End Function Public Sub splitRowsResize() Application.ScreenUpdating = False Dim topLeft As Range Set topLeft = Range("A1") Dim r As Range Set r = topLeft.CurrentRegion Dim rcc As Integer rcc = r.Columns.Count Const m& = 10 ^ 6 Dim arrRow& arrRow = 1 ReDim arr(1 To m, 1 To rcc) Dim i& i = 1 Dim coll As Collection Const delim = "," Do Until IsEmpty(r.Cells(i, 1)) newRows = 1 Set coll = New Collection For j = 1 To rcc a = Split(r.Cells(i, j), delim) newRows = newRows * (UBound(a) + 1) coll.Add a, CStr(j) Next j arrRow = arrRow + paintRows(arr, arrRow, i, coll) i = i + 1 Loop topLeft.Resize(arrRow, rcc) = arr Application.ScreenUpdating = True End Sub
我将数据集的topLeft设置为A1。 将其设置为适当的…