用逗号将单元格分隔成行，但保留周围列中的数据

Question

Excel 宏 - 逗号分隔单元格到行保留/聚合列

我的问题几乎与上面的链接完全相同，除了我有围绕我想要分解的列的数据，如下所示：

 <- 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（类别）-> <- B（项目）-> <- C（项目）-> <- D（项目）-> <- E（项目）->
  1 类别 1 日期 1 a a1 项目 1
  1 类别 1 日期 1 b b1 项目 1
  1 类别 1 日期 1 c c1 项目 1
  2 类别2 日期2 d d1 项目2
  3 Cat3 日期 3 e e1 项目 3
  3 Cat3 日期 3 f f1 项目 3 
  4 Cat4 date4 g g1 项目4

我想将 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

Answer 1

一个直接的简化是对于

 Set SourceRange = [A1].CurrentRegion

其余部分，看起来您走在正确的轨道上，但您想要更改 ListItems... 逻辑以设置一个布尔值来告诉您拆分其他列。

你最终会得到一个 If Then Else，一侧处理简单的行，而
另一侧处理多项目行。更多代码，但简单且不太可能包含错误。