Excel的VBA宏服用细胞对列

Question

我已存储的单电池内的数据：

<- 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 Macro - Comma Separated Cells to Rows Preserve/Aggregate Column的代码适用于两个相邻的列，但是如何复制一列范围？

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 = Range("A" & CStr(FirstRow) & ":B" & CStr(LastRow) & ",E" & _ 
         CStr(FirstRow) & ":E" & CStr(LastRow)) 

将允许您选择脱节范围。