Excel 2010 VBA - Split chaîne par Virgule, Passer Résultats Blank

Question

J'utilise le code suivant pour hacher une colonne de listes séparées par des virgules et retourner chaque entrée dans une nouvelle ligne:

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 

Bien que cette code fonctionne parfaitement, il a une faille fatale en ce que toute double virgule dans les cellules de la colonne C se traduira par des cellules vides poussés vers les nouvelles lignes dans la colonne G.

Est-ce que quelqu'un sait comment éditer le code de sorte qu'il ne crée pas de nouvelles lignes avec des cellules vides dans la colonne G, mais les saute et entre les lignes suivantes à leur place comme si les virgules superflues n'étaient jamais incluses dans la colonne C?

Answer 1

Vous pouvez boucle sur l'apparition de la virgule double pour nettoyer l'entrée par opposition à la fixation de la sortie, voici un exemple de travail:

Texte dans 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 

Vous feriez ce juste avant de se séparer

Si vous le souhaitez en fonction (serait mieux dans votre cas) faire:

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

Remplacez ensuite dans votre code:

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

Avec ceci:

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

Answer 2

Tout test pour la longueur de chaîne de strArr comme la première opération dans la Pour chaque strArr En boucle 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