excel - 用分隔列展开表

Question

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

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

Category    Items
Fruit       Apple,Orange
Vegetable   Carrot,Potato

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

Category    Items
Fruit       Apple
Fruit       Orange
Vegetable   Carrot
Vegetable   Potato

在此示例中，我们希望扩展表，以便每个项目都有自己的行，而不是在分隔列中的每个类别的同一行上。我们如何使用 Excel VBA 完成此任务？

Answer 1

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

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