Diviser les entrées séparées par des virgules en nouvelles lignes

J'ai actuellement ces données dans une feuille de

Col A   Col B
1       angry birds, gaming
2       nirvana,rock,band

Ce que je veux faire est de diviser l'séparées par des virgules, les entrées dans la deuxième colonne et les insérer dans de nouvelles lignes comme ci-dessous:

Col A   Col B
1   angry birds
1   gaming
2   nirvana
2   rock
2   band

Je suis sûr que cela peut être fait avec VBA, mais ne pouvait pas le comprendre moi-même.

source d'informationauteur redGREENblue

  1. 23

    Vous êtes mieux d'utiliser la variante de tableaux plutôt que des cellules boucles - ils sont beaucoup plus rapide code sage une fois les ensembles de données sont significatives. Même thoug le code est plus long 🙂

    Cet échantillon ci-dessous décharges à la colonne C et D, de sorte que vous pouvez voir à l'origine des données.
    Changement [c1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y) à [a1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y) de vidage sur vos données d'origine

    [Mis à jour avec les regexp pour supprimer les éventuels espaces après , ie ", le groupe" devient "le groupe"]

    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

    Diviser les entrées séparées par des virgules en nouvelles lignes

  2. 4

    Prend vos données dans la colonne A et met les résultats dans la colonne 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