vba - 将逗号分隔的条目拆分为新行

Question

已关闭。此问题需要 debugging details 。目前不接受答案。

---

编辑问题以包含 desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem 。这将有助于其他人回答问题。

已关闭 8 年前。

Improve this question

我目前在工作表中拥有这些数据

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) 转储原始数据

[使用正则表达式进行更新，删除 , 之后的所有空格，即“, band”变为“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