Excel 2010 VBA – 按逗号分割string，跳过空白结果

我正在使用下面的代码砍掉一列逗号分隔的列表，并返回一个新行中的每个条目：

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中的新行。

有谁知道如何编辑代码，以便它不创buildG列中的空单元格的新行，但跳过它们，并进入他们的地方的下一行，就像多余的逗号从来没有包含在列C中呢？

Answer 1

只需testingstrArr的string长度，作为For Each strArr在tempArr循环中的第一个操作。

 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 

Answer 2

你可以循环的双重逗号的出现清理input，而不是固定输出，这里是一个工作的例子：

在A1中的文本： Hello,,World,This,,Is,,,,,,,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 

你会在分裂之前这样做

如果你想要它作为一个function（在你的情况会更好）做到这一点：

 Function FixDoubleComma(MyString As String) Do Until Len(MyString) = Len(Replace(MyString, ",,", ",")) MyString = Replace(MyString, ",,", ",") Loop FixDoubleComma = MyString End Function 

然后在你的代码中replace这个：

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

有了这个：

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