Excel Macro - Cellules Séparées par des Virgules pour les Lignes

J'ai avez les données suivantes dans excel:

a, b, c
d
e
f, g
h
i

à chaque ligne, ce qui représente une ligne et une cellule.

Je voudrais le convertir en:

a
b
c
d
e
f
g
h
i

Je suis en utilisant la macro suivante, mais je ne peux pas obtenir la propriété autosize de faire une insertion, au lieu de substituant les valeurs de cellule. Toute aide est appréciée.

    Sub SplitCells()


    Dim i As Long



    With Application

        .Calculation = xlCalculationManual

        .ScreenUpdating = False




    For i = 1 To Selection.Rows.Count

        Dim splitValues As Variant


        splitValues = split(Selection.Rows(i).Value, ",")

        Selection.Rows(i).Resize(UBound(splitValues) - LBound(splitValues) + 1).Value = Application.Transpose(splitValues)

    Next i



        .Calculation = xlCalculationAutomatic

        .ScreenUpdating = True

    End With

End Sub

OriginalL'auteur B Z | 2009-01-23

Cette macro ne prenez vos données de la colonne A et "extraire" à la colonne B. Les résultats sont présentés ci-dessous, n'hésitez pas à trembler à ma présentation graphique des compétences 🙂

    <- A ->   <- B ->
1   a, b, c   a
2   d         b
3   e         c
4   f, g      d
5   h         e
6   i         f
7             g
8             h
9             i

J'ai laissé comme non-destructive des fins de test, et depuis il est relativement facile de créer une nouvelle colonne, de le remplir et de supprimer l'ancienne colonne en VBA. Un exercice pour le lecteur...

Voici la macro:

Option Explicit
Sub Macro1()
Dim fromCol As String
Dim toCol As String
Dim fromRow As String
Dim toRow As String
Dim inVal As String
Dim outVal As String
Dim commaPos As Integer
' Copy from column A to column B.'
fromCol = "A"
toCol = "B"
fromRow = "1"
toRow = "1"
' Go until no more entries in column A.'
inVal = Range(fromCol + fromRow).Value
While inVal <> ""
' Go until all sub-entries used up.'
While inVal <> ""
Range(fromCol + fromRow).Select
' Extract each subentry.'
commaPos = InStr(1, inVal, ",")
While commaPos <> 0
' and write to output column.'
outVal = Left(inVal, commaPos - 1)
Range(toCol + toRow).Select
Range(toCol + toRow).Value = outVal
toRow = Mid(Str(Val(toRow) + 1), 2)
' Remove that sub-entry.'
inVal = Mid(inVal, commaPos + 1)
While Left(inVal, 1) = " "
inVal = Mid(inVal, 2)
Wend
commaPos = InStr(1, inVal, ",")
Wend
' Get last sub-entry (or full entry if no commas).'
Range(toCol + toRow).Select
Range(toCol + toRow).Value = inVal
toRow = Mid(Str(Val(toRow) + 1), 2)
inVal = ""
Wend
' Advance to next source row.'
fromRow = Mid(Str(Val(fromRow) + 1), 2)
Range(fromCol + fromRow).Select
inVal = Range(fromCol + fromRow).Value
Wend
End Sub

fonctionne très bien, merci

OriginalL'auteur paxdiablo

Ce n'est pas testé, mais c'est un algorithme pour le modèle que j'ai utilisé à de nombreuses reprises. Il a été un certain temps cependant, afin de ne pas faire confiance à la syntaxe exactement.

sub SplitCells()  
Dim c as Range      ' iterator for cells in Selection  
dim r as Range      ' to hold the range which is the first cell in Selection  
Dim r2 as Range     ' variable range for single cell which is the target for inserting the result  
Dim a() a Variant   ' array of variants to hold each cell's value after it's split  
Dim b() as Variant  ' array of variants to hold the accumulation of values to spread into the destination  
Dim v ar Variant    ' variant to iterate through b for insertion  
Dim i as Integer    ' cumulative offset from top of destination range while inserting  
For each c in Selection.Cells  
a = Split(Replace(c.Text, ",", "")) ' will split on whitespace  
for each v in a  
b.Add v  
next v  
next c  
' now you have a new array with the full set of values  
' insert them a row at a time using Range.Offset  
i = 0  
Set r = Selection.Cells(0)  
For Each v in b  
Set r2 = r.Offset(1, 0)  
r2.Value = v  
i = i + 1  
next v  
End Sub

Vous ne savez que vous aurez une erreur de syntaxe sur "Dim a() une Variante", n'est-ce pas? Je ne sais pas quel est le problème avec elle, je n'ai jamais utilisé des variantes ou des tableaux en VBA (mes tableaux sont généralement stockés dans des cellules Excel :-).

OriginalL'auteur dkretz

Je ne suis pas très bon à Excel VBA, mais cela a fonctionné (en quelque sorte!!)

Sub arrange()
' get the current range from the sheet
curr_range = ActiveSheet.Range("A1:A6")
' for each cell in that range ...
For Each Row In curr_range
' ...put the contents into an array
arr = Split(Row, ",")
' for each cell in that array ...
For Each cell In arr
' ...output it into a string
output_str = output_str & "," & cell
Next cell
Next Row
' remove spaces
output_str = Replace(output_str, " ", "")
' remove left ,
output_str = Right(output_str, Len(output_str) - 1)
' make it into an array
output_arr = Split(output_str, ",")
' populate the sheet back
ActiveSheet.Range("A:A").Value = Application.WorksheetFunction.Transpose(output_arr)
End Sub

Je déteste ce que ne SORTE avec VBA commentaires - je trouve que vous avez besoin de mettre un """ à la fin de la ligne pour s'assurer de coloriage fonctionne correctement.
Je reçois tout un tas de N/A #cellules dans les cellules appropriées lorsque je l'exécute.
Petites critiques (pas la peine downvoting): 1/ Vous supprimez tous les espaces à l'intérieur d'un champ (par exemple, "bob, jill smith, george" devient "bob", "jillsmith", "george"). 2/ Votre "supprimer" de gauche " est mieux que "output_str = mid(output_str,2)". Autre que cela, et le NA, il semble très bien.

OriginalL'auteur abhijit

Vous devez vous connecter pour publier un commentaire.