[英]Excel VBA Macro Taking Cells to Columns
I have data stored within single cells:我将数据存储在单个单元格中:
<- 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
I want to transfer it to the following format:我想将其转换为以下格式:
<- 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
(ie I want to break Columns C and D into new rows and copy the items in A,B, and E). (即我想将列 C 和 D 拆分为新行并复制 A、B 和 E 中的项目)。
The code from Excel Macro - Comma Separated Cells to Rows Preserve/Aggregate Column works perfect for two adjacent columns, but how do I copy a range of columns? 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
Using the ,
in between the individual ranges在各个范围之间使用
,
Set SourceRange = Range("A" & CStr(FirstRow) & ":B" & CStr(LastRow) & ",E" & _
CStr(FirstRow) & ":E" & CStr(LastRow))
will allow you to select the disjointed range.将允许您对 select 脱节范围。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.