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
没有找到相关结果
已邀请:
1 个回复
娠侈脚惮顽
将允许您选择不相交的范围。