Excel Macro - Comma Separated Cells to Rows Preserve/Aggregate Column
我的问题与上面的链接几乎完全一样,除了我想要突破的列数据如下:
<- A (Category) -> <- B (Items) -> <- B (Items) -> <- B (Items) -> <- B (Items) ->
1 Cat1 date1 a,b,c a1,b1,c1 item1
2 Cat2 date2 d d1 item2
3 Cat3 date3 e,f e1,f1 item3
4 Cat4 date4 g g1 item4
我想要的是:
<- A (Category) -> <- B (Items) -> <- C (Items) -> <- D (Items) -> <- E (Items) -> 1 Cat1 date1 a a1 item1 1 Cat1 date1 b b1 item1 1 Cat1 date1 c c1 item1 2 Cat2 date2 d d1 item2 3 Cat3 date3 e e1 item3 3 Cat3 date3 f f1 item3 4 Cat4 date4 g g1 item4
我想将C列和D列拆分为新行并复制A,B和E中的项目。实际上有更多列,但我这样做是为了让它更容易。
以下代码仅适用于2个相邻列。我想知道是否可以输入一系列列进行复制?
Sub ExpandData()
Const FirstRow = 2
Dim LastRow As Long
LastRow = Range("A" & CStr(Rows.Count)).End(xlUp).Row
' Get the values from the worksheet
Dim SourceRange As Range
Set SourceRange = Range("A" & CStr(FirstRow) & ":B" & CStr(LastRow))
' Get sourcerange values into an array
Dim Vals() As Variant
Vals = SourceRange.Value
' Loop through the rows in the array and split each comma-delimited list of items and put each on its own row
Dim ArrIdx As Long
Dim RowCount As Long
For ArrIdx = LBound(Vals, 1) To UBound(Vals, 1)
Dim CurrCat As String
CurrCat = Vals(ArrIdx, 1)
Dim CurrList As String
CurrList = Replace(Vals(ArrIdx, 2), " ", "")
Dim ListItems() As String
ListItems = Split(CurrList, ",")
Dim ListIdx As Integer
For ListIdx = LBound(ListItems) To UBound(ListItems)
Range("A" & CStr(FirstRow + RowCount)).Value = CurrCat
Range("B" & CStr(FirstRow + RowCount)).Value = ListItems(ListIdx)
RowCount = RowCount + 1
Next ListIdx
Next ArrIdx
End Sub
答案 0 :(得分:0)
立即简化是
Set SourceRange = [A1].CurrentRegion
对于其他人来说,看起来你正处于正确的轨道上,但你想改变ListItems ...逻辑来设置一个布尔值来告诉你拆分其他列。
你最终得到了一个If Then Else,其中一方处理简单的行和 处理多项目行的另一方。更多代码,但简单且不太可能存在错误。