Arrays Excel 2010 VBA-按逗号拆分字符串，跳过空白结果

我使用以下代码切碎一列逗号分隔的列表，并在新行中返回每个条目：

Sub SliceNDice()
    '
    ' Splits the locations cells according to commas and pushes to new rows
    ' Code courtesy of brettdj (http://stackoverflow.com/questions/8560718/split-comma-separated-entries-to-new-rows)
    '
    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, "c").End(xlUp)).Value2
    ReDim Y(1 To 3, 1 To 1000)
    For lngRow = 1 To UBound(x, 1)
         'Split each string by ","
        tempArr = Split(x(lngRow, 3), ",")
        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 3, 1 To lngCnt + 1000)
            Y(1, lngCnt) = x(lngRow, 1)
            Y(2, lngCnt) = x(lngRow, 2)
            Y(3, lngCnt) = objRegex.Replace(strArr, "$1")
        Next
    Next lngRow
     'Dump the re-ordered range to columns E:G
    [e1].Resize(lngCnt, 3).Value2 = Application.Transpose(Y)

End Sub

虽然这段代码工作得很好，但它有一个致命的缺陷，即C列单元格中的任何双逗号都会导致空白单元格被推到G列的新行

---

是否有人知道如何编辑代码，使其不会在G列中创建包含空单元格的新行，而是跳过它们并在其位置输入下一行，就好像多余的逗号从未包含在C列中一样？

您可以循环出现双逗号来清理输入，而不是修复输出，以下是一个工作示例：

A1中的文本：

Hello，，World，这里是，，，，，，，A，，Test

Sub TestString()
Dim MyString As String
MyString = Range("A1").Text
Do Until Len(MyString) = Len(Replace(MyString, ",,", ","))
    MyString = Replace(MyString, ",,", ",")
Loop
MsgBox MyString
End Sub

你应该在分开之前这样做

如果您希望将其作为一种功能（在您的情况下会更好），请执行以下操作：

然后在代码中替换此项：

tempArr = Split(x(lngRow, 3), ",")

为此：

tempArr = Split(FixDoubleComma(x(lngRow, 3)), ",")

---

只需测试strArr的字符串长度，作为tempArr循环中for Each strArr的第一个操作

For Each strArr In tempArr
    If CBool(Len(strArr)) Then
        lngCnt = lngCnt + 1
         'Add another 1000 records to resorted array every 1000 records
        If lngCnt Mod 1000 = 0 Then ReDim Preserve Y(1 To 3, 1 To lngCnt + 1000)
        Y(1, lngCnt) = x(lngRow, 1)
        Y(2, lngCnt) = x(lngRow, 2)
        Y(3, lngCnt) = objRegex.Replace(strArr, "$1")
    End If
Next strArr

---

我有一个小样本，可以解决所有的空白

Sub-removebanks（）
将mystr变暗为字符串
Dim arrWithBlanks（）作为字符串
Dim arrNoBlanks（）作为字符串
作为整数的Dim i
mystr=“、汤姆、杰瑞、、斯派克、、”到处空白（开头、中间和结尾）
arrhithblanks=Split（mystr，“，”）
ReDim arrNoBlanks（0到0）
调试.打印“带空格的数组：”
'使用空格在数组中循环
对于i=LBound（带边框）到UBound（带边框）
'检查是否有空白（或仅带空格的元素）
如果修剪（带空格（i））=“则
调试。打印i&（空白）
其他的
调试.打印i&“”&带边框空白（i）
如果arrNoBlanks（UBound（arrNoBlanks））“”则ReDim保留arrNoBlanks（0到UBound（arrNoBlanks）+1）
arrNoBlanks（UBound（arrNoBlanks））=带空格的arrNoBlanks（i）
如果结束
接下来我
调试.打印“不带空格的数组：”
对于i=LBound（arrNoBlanks）到UBound（arrNoBlanks）
Debug.Print i&“”和arrNoBlanks（i）
接下来我
端接头

所有内容都将显示在即时窗口中（按Ctrl+G键显示）

结果如下所示：

Array with blanks:  
0 (blank)
1 tom
2 jerry
3 (blank)
4 (blank)
5 spike
6 (blank)
7 (blank)
Array with NO blanks:
0 tom
1 jerry
2 spike

---

很好，但我认为它不包括逗号开始或结束连接字符串。为什么不简单地测试strArr的长度，作为tempArr循环中for Each strArr中的第一件事呢？正如Jeeped所说，这是一个很好的解决方案：）

Array with blanks:  
0 (blank)
1 tom
2 jerry
3 (blank)
4 (blank)
5 spike
6 (blank)
7 (blank)
Array with NO blanks:
0 tom
1 jerry
2 spike