我目前在表格中有这些数据
Col A Col B
1 angry birds, gaming
2 nirvana,rock,band
我想要做的是在第二列中拆分逗号分隔的条目并插入新的行,如下所示:
Col A Col B
1 angry birds
1 gaming
2 nirvana
2 rock
2 band
我确信这可以通过VBA完成,但无法自己解决。
答案 0 :(得分:24)
最好使用变量数组而不是单元循环 - 一旦数据集有意义,它们的代码就会快得多。即使代码更长:)
下面的示例转储到C列和D列,以便您可以看到原始数据。
将[c1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y)
更改为[a1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y)
以转储原始数据
[使用正则表达式更新以删除,
之后的任何空格即“,”乐队“变为”乐队“]
Sub SliceNDice()
Dim objRegex As Object
Dim X
Dim Y
Dim lngRow As Long
Dim lngCnt As Long
Dim tempArr() As String
Dim strArr
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "^\s+(.+?)$"
'Define the range to be analysed
X = Range([a1], Cells(Rows.Count, "b").End(xlUp)).Value2
Redim Y(1 To 2, 1 To 1000)
For lngRow = 1 To UBound(X, 1)
'Split each string by ","
tempArr = Split(X(lngRow, 2), ",")
For Each strArr In tempArr
lngCnt = lngCnt + 1
'Add another 1000 records to resorted array every 1000 records
If lngCnt Mod 1000 = 0 Then Redim Preserve Y(1 To 2, 1 To lngCnt + 1000)
Y(1, lngCnt) = X(lngRow, 1)
Y(2, lngCnt) = objRegex.Replace(strArr, "$1")
Next
Next lngRow
'Dump the re-ordered range to columns C:D
[c1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y)
End Sub
答案 1 :(得分:5)
在A列中获取数据并将结果放在C列中。
Sub SplitAll()
Dim src As Range
Dim result As Variant
For Each src In Range("A:A").SpecialCells(xlCellTypeConstants)
result = Split(src, ",")
'last cell in column C
With Cells(Rows.Count, 3).End(xlUp)
Range(.Offset(1, 0), .Offset(1 + UBound(result, 1), 0)) = Application.WorksheetFunction.Transpose(result)
End With
Next src
End Sub