Excel 用分隔列展开表
我经常看到这个问题，所以我正在创建这个问题和答案，这样我和其他贡献者将来就可以指向它 假设我们有一个情况，其中有一个表，看起来像这样：Excel 用分隔列展开表,excel,vba,Excel,Vba,我经常看到这个问题，所以我正在创建这个问题和答案，这样我和其他贡献者将来就可以指向它 假设我们有一个情况，其中有一个表，看起来像这样： Category Items Fruit Apple,Orange Vegetable Carrot,Potato 我们想把它变成一张像这样的桌子： Category Items Fruit Apple Fruit Orange Vegetable Carrot Vegetable Potato 在
Category Items
Fruit Apple,Orange
Vegetable Carrot,Potato
Category Items
Fruit Apple
Fruit Orange
Vegetable Carrot
Vegetable Potato
在本例中，我们希望扩展该表，以便每个项都有自己的行，而不是位于分隔列中每个类别的同一行上。如何使用Excel VBA完成此任务？此代码将完成此任务。它还可以自定义，以便您可以输入表区域、分隔列和分隔符，以便它可以应用于大多数情况。默认值适用于问题中描述的示例
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
此代码将完成此任务。它还可以自定义，以便您可以输入表区域、分隔列和分隔符，以便它可以应用于大多数情况。默认值适用于问题中描述的示例
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
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"
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"