У меня есть данные, хранящиеся в отдельных ячейках:
<- 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