拆分逗号分隔的条目到新行 [英] Split comma separated entries to new rows
问题描述
我目前在表格中有这些数据
I currently have this data in a sheet
Col A Col B
1 angry birds, gaming
2 nirvana,rock,band
我想做的是将逗号分隔的条目拆分为第二列并插入新行,如下所示:
What I want to do is split the comma separated entries in the second column and insert in new rows like below:
Col A Col B
1 angry birds
1 gaming
2 nirvana
2 rock
2 band
我是确定这可以使用VBA完成,但无法自己弄清楚。
I am sure this can be done with VBA but couldn't figure it out myself.
推荐答案
你最好使用变体数组而不是单元循环 - 一旦数据集有意义,它们就更快地代码。即使代码更长:)
You are better off using variant arrays rather than cell loops - they are much quicker code wise once the data sets are meaningful. Even thoug the code is longer :)
下面的示例转储到列C和D,以便您可以看到原始数据。
更改 [c1] .Resize(lngCnt,2).Value2 = Application.Transpose(Y)
to [a1] .Resize lngCnt,2).Value2 = Application.Transpose(Y)
转储您的原始数据
This sample below dumps to column C and D so that you can see the orginal data.
Change [c1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y)
to [a1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y)
to dump over your original data
[用regexp更新以删除之后的任何空格,
ie,band变成band]
[Updated with regexp to remove any blanks after ,
ie ", band" becomes "band"]
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
这篇关于拆分逗号分隔的条目到新行的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!