使用分隔列展开表

时间:2018-01-23 15:35:15

标签: excel vba

我经常看到这个问题,所以我创建了这个问题和答案,所以我(以及其他贡献者)可以在将来指出它。

我们假设有一个表格看起来像这样:

Category    Items
Fruit       Apple,Orange
Vegetable   Carrot,Potato

我们想把它变成一个看起来像这样的表:

Category    Items
Fruit       Apple
Fruit       Orange
Vegetable   Carrot
Vegetable   Potato

在此示例中,我们要扩展表,以便每个项都有自己的行,而不是在分隔列中的每个类别的同一行上。我们如何使用Excel VBA实现这一目标?

2 个答案:

答案 0 :(得分:2)

此代码将完成任务。它也可以自定义,以便您可以输入表区域,分隔列和分隔符,以便它可以应用于大多数情况。默认值适用于问题中描述的示例。

Sub SplitDelimColToConvertTable()
'Created by TigerAvatar on Jan 23 2018
'Converts a table that contains a column with delimited information
'    into a table where the delimited column has been split so that
'    each item is on its own row
'Example:
'    Fruit        Apple,Orange
'    Vegetable    Carrot,Potato
'Becomes
'    Fruit        Apple
'    Fruit        Orange
'    Vegetable    Carrot
'    Vegetable    Potato

    Const ColStart As String = "A"  'Column where your table to convert starts
    Const ColFinal As String = "B"  'Column where your table to convert ends
    Const ColDelim As String = "B"  'Column containing the delimited data (does not have to be the same as ColFinal)
    Const RowStart As String = 2    'Row where your table to convert starts; do NOT use the header row (if any)
    Const Delimiter As String = "," 'The delimiter that will be split on

    Dim ws As Worksheet
    Dim Results() As Variant
    Dim Data As Variant
    Dim Part As Variant
    Dim ColDelimAddr As String
    Dim ColDelimNum As Long
    Dim iData As Long
    Dim iResults As Long
    Dim j As Long

    Set ws = ActiveWorkbook.Sheets("sheet1")
    With ws.Range(ColStart & RowStart, ws.Cells(ws.Rows.Count, ColStart).End(xlUp))
        ColDelimNum = Columns(ColDelim).Column - Columns(ColStart).Column + 1
        ColDelimAddr = .Offset(, ColDelimNum - 1).Address(External:=True)
        Data = .Resize(, Columns(ColFinal).Column - Columns(ColStart).Column + 1).Value
        ReDim Results(1 To Evaluate("SUMPRODUCT(LEN(" & ColDelimAddr & ")-LEN(SUBSTITUTE(" & ColDelimAddr & ","","",""""))+1)"), 1 To UBound(Data, 2))
    End With

    For iData = LBound(Data, 1) To UBound(Data, 1)
        For Each Part In Split(Data(iData, ColDelimNum), Delimiter)
            iResults = iResults + 1
            For j = LBound(Data, 2) To UBound(Data, 2)
                If j = ColDelimNum Then
                    Results(iResults, j) = Trim(Part)
                Else
                    Results(iResults, j) = Data(iData, j)
                End If
            Next j
        Next Part
    Next iData

    'This overwrites your original table with the split out result data
    'If you want the original table preserved, change the ColStart & RowStart to be where you want the output
    'Example: ws.Range("E1").Resize(......
    ws.Range(ColStart & RowStart).Resize(UBound(Results, 1), UBound(Results, 2)).Value = Results

End Sub

答案 1 :(得分:2)

另一种选择是使用 Power Query ;现在名为 Get&变换即可。它是自Excel 2010版本以来发布的外接程序,用于ETL(提取,转换,加载)/为数据分析开发。在那里,您可以连接多个源并根据需要转换数据。

我们可以在应用步骤中逐步检查,它也有自己的代码,称为 Power M语言;我们可以在高级编辑器主页标签中找到它,我们可以逐行查看和修改您的转换步骤。

let
    Source = Excel.CurrentWorkbook(){[Name="Table3"]}[Content],
    #"Split Column by Delimiter" = Table.SplitColumn(Source, "Items", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), {"Items.1", "Items.2"}),
    #"Changed Type" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Items.1", type text}, {"Items.2", type text}}),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Category"}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Other Columns",{"Attribute"}),
    #"Renamed Columns" = Table.RenameColumns(#"Removed Columns",{{"Value", "Item"}})
in
    #"Renamed Columns"