SliceNDice pour 3 colonnes

Question

J'adore SliceNDice de sous brettdj de:

Split comma separated entries to new rows

Je l'utilise tout le temps. J'ai maintenant une situation avec trois colonnes et pour la vie de moi - je ne peux pas comprendre comment changer le vba pour le faire fonctionner. La troisième colonne serait celle avec les valeurs délimitées par des virgules. Les deux premières colonnes sont des entrées uniques. La première fois que je poste pour moi, je saisis les bras de ma chaise au cas où j'aurais fait quelque chose de mal.

Answer 1

Si vous tentez de conserver les première et deuxième colonnes dans chaque ligne suivante tout en ajoutant chaque valeur séparée dans la troisième colonne, cela devrait fonctionner.

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, "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 C:D 
[d1].Resize(lngCnt, 3).Value2 = Application.Transpose(Y) 
End Sub 

données de l'échantillon: