Excel VBA宏将单元格带到列

| 我将数据存储在单个单元格中:
 <- A (Category) ->   <- B (Items) -> <- C (Items) -> <- D (Items) -> <- E (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中的项目)。 Excel宏-逗号分隔的单元格到行保留/汇总列中的代码非常适合两个相邻列,但是如何复制一定范围的列?
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
    
已邀请:
        在各个范围之间使用
,
Set SourceRange = Range(\"A\" & CStr(FirstRow) & \":B\" & CStr(LastRow) & \",E\" & _
                        CStr(FirstRow) & \":E\" & CStr(LastRow))
将允许您选择不相交的范围。     

要回复问题请先登录注册