分割逗号分隔条目到新行

我目前在一张表中有这个数据

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来完成，但不能自己弄清楚。

Answer 1

你最好使用变体数组而不是单元循环 – 一旦数据集有意义，它们的代码更加快捷。 即使你的代码更长:)

下面的示例将转储到C和D列，以便您可以看到原始数据。 更改[c1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y)到[a1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y)转储您的原始数据

[更新与正则expression式删除任何空白后,即“乐队”成为“乐队”]

 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 

Answer 2

将数据存入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