0

我有下表：

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 列。

4

2 回答 2

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)

并复制下来以适应。

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

于 2013-08-09T18:05:13.300 回答
0

这是一个 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

如何使用宏：

  1. 制作宏将在其上运行的工作簿的副本
    • 始终在工作簿副本上运行新代码，以防代码运行不顺畅
    • 对于删除任何内容的任何代码来说尤其如此
  2. 在复制的工作簿中，按 ALT+F11 打开 Visual Basic 编辑器
  3. 插入 | 模块复制提供的代码并粘贴到模块中
  4. 关闭 Visual Basic 编辑器
  5. 在 Excel 中，按 ALT+F8 以调出要运行的可用宏列表
  6. 双击所需的宏（我将这个命名为 tgr）
于 2013-08-09T18:04:36.593 回答