Question

我有下表：

Name        Group
John        2A
John        1B
Barry       2A
Ron         1B
Ron         2A
Ron         2C

我想知道Excel中是否有任何实用程序，我可以将组列分隔为每个实例的新列。

预期结果

Name        Group1      Group2      Group3
John        2A          1B
Barry       2A
Ron         1B          2A          2C

在这个例子中我知道最大组是3.所以我创建了Group1，Group2和Group3列。

Answer 1

假设2C在B7中并处理副本，请输入：

=IF(COLUMN()<COUNTIF($A:$A,$A2)+2,IF($A2=$A3,INDIRECT("$B"&ROW()+COLUMN()-2),""),"")

在C2中并复制（到ColumnZ或者如果你愿意，可以进一步复制到ColumnD就足以满足你的例子）并且适合。

在可用列中：

=OR(A1=A3,A1=A2)

并复制以适应。

修复公式（选择/复制/粘贴特殊值），过滤“可用”列以选择“真”，删除所选行并删除“可用”列。添加列标签以适应。

Answer 2

这是一个VBA解决方案，它将转换后的表放在新工作表上：

Sub tgr()

    Dim wsData As Worksheet
    Dim wsDest As Worksheet
    Dim NameCell As Range
    Dim rngFound As Range
    Dim arrData() As Variant
    Dim strFirst As String
    Dim DataIndex As Long
    Dim cIndex As Long

    Set wsData = ActiveSheet
    Set wsDest = Sheets.Add(After:=Sheets(Sheets.Count))
    wsData.Range("A1", wsData.Cells(Rows.Count, "A").End(xlUp)).AdvancedFilter xlFilterCopy, , wsDest.Range("A1"), True
    wsData.Range("B1", wsData.Cells(Rows.Count, "B").End(xlUp)).AdvancedFilter xlFilterCopy, , wsDest.Range("B1"), True
    wsDest.Range("B2", wsDest.Cells(Rows.Count, "B").End(xlUp)).Copy
    wsDest.Range("B1").PasteSpecial xlPasteValues, Transpose:=True
    With wsDest.Range("A1", wsDest.Cells(1, Columns.Count).End(xlToLeft))
        .Font.Bold = True
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        With .Offset(, 1).Resize(, .Columns.Count - 1)
            .Value = Application.Transpose(Evaluate("Index(""Group""&Row(1:" & .Columns.Count & "),)"))
        End With
    End With
    ReDim arrData(1 To wsDest.Cells(Rows.Count, "A").End(xlUp).Row - 1, 1 To wsDest.Cells(1, Columns.Count).End(xlToLeft).Column - 1)
    For Each NameCell In wsDest.Range("A2", wsDest.Cells(Rows.Count, "A").End(xlUp)).Cells
        DataIndex = DataIndex + 1
        Set rngFound = wsData.Columns("A").Find(NameCell.Text, , xlValues, xlWhole)
        If Not rngFound Is Nothing Then
            cIndex = 0
            strFirst = rngFound.Address
            Do
                cIndex = cIndex + 1
                arrData(DataIndex, cIndex) = wsData.Cells(rngFound.Row, "B").Text
                Set rngFound = wsData.Columns("A").Find(NameCell.Text, rngFound, xlValues, xlWhole)
            Loop While rngFound.Address <> strFirst
        End If
    Next NameCell

    If DataIndex > 0 Then wsDest.Range("B2").Resize(UBound(arrData, 1), UBound(arrData, 2)).Value = arrData

    Set wsData = Nothing
    Set wsDest = Nothing
    Set NameCell = Nothing
    Set rngFound = Nothing
    Erase arrData

End Sub

如何使用宏：

制作将运行宏的工作簿的副本
- 始终在工作簿副本上运行新代码，以防代码运行不顺利
- 对于任何删除任何内容的代码
在复制的工作簿中，按ALT + F11以打开Visual Basic编辑器
插入|模块复制提供的代码并粘贴到模块中
关闭Visual Basic编辑器
在Excel中，按ALT + F8以显示要运行的可用宏列表
双击所需的宏（我将其命名为tgr）

Excel：行值到列

2 个答案: