将未连接的行反向转置到列答案

【问题标题】：Reverse transpose un-concatenate rows to columns将未连接的行反向转置到列
【发布时间】：2015-11-09 22:26:13
【问题描述】：

我在 Excel 中有以下宏来获取这样的两列

Client | Product 
12     | A
12     | B
12     | C
15     | A
15     | C

并将它们转置为

Client | Product 
12     | A,B,C
15     | A,C

现在我想创建一个执行反向操作的 excel 宏，并采用这样的两列并反向转置将它们取消连接到

Client | Product 
12     | A
12     | B
12     | C
15     | A
15     | C

我尝试了 Text to Column 功能，但它创建了这个

Client | Product 
12     | A        |B       |C
15     | A        |C

这是宏：

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

【问题讨论】：

你有没有试过写一个宏来做相反的事情？您可以使用Split() 从连接的值创建一个数组，然后循环该数组以填充新格式。
感谢您的回复，您是指通过“内置”反向转置手动复制/粘贴吗？问题是在我的文件中我有数千个客户端，因此使用内置功能手动完成它会花费太长时间；我正在反向宏中尝试拆分功能
试试我的子和功能代码。它适用于存在数据字段的任意数量的列。如果有任何问题，请告诉我...
有什么对你有用的吗？

标签： vba excel

【解决方案1】：

一旦你得到这个结果，你就可以运行我的 Unpivot 插件来转换回你想要的输出

输入：

Client | Product 
12     | A        |B       |C
15     | A        |C

输出

Client | Product 
12     | A
12     | B
12     | C
15     | A
15     | C

您可以download the add-in here，在启动前选择您的第一个产品代码（本例中为“A”）。

【讨论】：

【解决方案2】：

你可以搞砸这个。如果需要，请整理数组尺寸：

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。将其设置为合适的...

【讨论】：