Autres Séparer Numéro du texte dans 2 colonnes différentes

[cp4]

Bonjour,

J'ai parcouru plein de discussions, mais j'avoue que je suis un peu perdu. Merci de me venir en aide pour un code VBA efficace.
J'ai récupéré une liste de chaînes TV/Radio (bouquet) en colonne A. Chaque cellule est constituée d'un numéro et du nom de la chaîne.
Je voudrais parcourir la colonne A pour mettre en colonne C le numéro et en colonne D le nom de la chaîne.
Le résultat escompté est sur la feuille1.
En vous remerciant par avance.

ps: je suis sous excel2007

 

[laurent950]

Bonjour,

Sub test()
    Dim t As Variant
    For i = 2 To ActiveSheet.Cells(ActiveSheet.Cells(65535, 1).End(xlUp).Row, 1).Row
        ActiveSheet.Cells(i, 3) = Split(ActiveSheet.Cells(i, 1), " ")(0)
        For j = 1 To UBound(Split(ActiveSheet.Cells(i, 1), " "))
            ActiveSheet.Cells(i, 4) = ActiveSheet.Cells(i, 4) & Split(ActiveSheet.Cells(i, 1), " ")(j) & " "
        Next j
    Next i
End Sub

 

[cp4]

Bonjour Laurent950,

Merci beaucoup. Ton code fonctionne parfaitement bien. Je n'ai eu qu'à adapter à mon fichier et déclarer les variables i, j.

Je me suis lancé dans des recherches pas possibles. Enfin, mon idée était de repérer le 1er "espace" à partir de la gauche et essayer de séparer en 2 la chaîne de caractères se trouvant de par et d'autre du 1er espace. Mais je me suis noyé dans un "dé à coudre".

Merci d'éclairer ma lanterne sur le (0) de la ligne de code repérée par '***'.

Sub test()
    Dim t As Variant, i As Integer, j As Integer
    With ActiveSheet
        For i = 1 To .Cells(.Cells(65535, 1).End(xlUp).Row, 1).Row
            .Cells(i, 3) = Split(.Cells(i, 1), " ")(0) '***'
            For j = 1 To UBound(Split(.Cells(i, 1), " "))
                .Cells(i, 4) = .Cells(i, 4) & Split(.Cells(i, 1), " ")(j) & " "
            Next j
        Next i
    End With
End Sub

Toute ma gratitude.

 

[jmfmarques]

Bonjour
2 simples formules Excel --->>

En B1 (et tirer vers le bas) :

=GAUCHE(A1;TROUVE(" ";A1;1))

En C1 (et tirer vers le bas) :

=STXT(A1;TROUVE(" ";A1;1);NBCAR(A1))

27 BLABLA TOTO	27	BLABLA TOTO
3 EUROPE 1	3	EUROPE 1
18 RPP NOTICIAS	18	RPP NOTICIAS

 

[cp4]

Bonjour Jmfmarques ,

Très sympa de ta part. Je vais rajouter tes formules à mon fichier (j'en aurais surement besoin).
Mais sur ce coup, c'est de VBA dont j'avais besoin pour ce fichier. D'ailleurs ça m'a inspiré pour un autre problème à peu près similaire.

Merci quand même.

 

[jmfmarques]

Pourquoi donc utiliser VBA pour si peu ?
Mais bon . regarde alors ce que ferait ceci :

For Each c In Columns(1).SpecialCells(xlConstants).Cells
  pos = InStr(c, " ")
  c(1, 2).Value = Left(c.Value, pos - 1)
  c(1, 3).Value = Mid(c.Value, pos + 1)
Next

qui permet d'éviter la fonction split (plus lourde)

27 BLABLA TOTO	27​	BLABLA TOTO
3 EUROPE 1	3​	EUROPE 1
18 RPP NOTICIAS	18​	RPP NOTICIAS

 

[laurent950]

Le découpage de la chaine se fait pour chaque espace :
.Cells(i, 3) = Split(.Cells(i, 1), " ")(0)
donc par exemple lorsque l'on découpe cette chaine :
cells(1,4) = "207 Science & Vie TV"
il y a 4 espaces
donc
207 : Split(.Cells(i, 1), " ")(0)
Science : Split(.Cells(i, 1), " ")(1)
& : Split(.Cells(i, 1), " ")(2)
Vie : Split(.Cells(i, 1), " ")(3)
TV : Split(.Cells(i, 1), " ")(4)

 

[job75]

Bonjour cp4, laurent950, jmfmarques,

En VBA l'entrée de données une par une dans chaque cellule peut prendre beaucoup de temps.

Il est préférable d'utiliser des tableaux VBA ou une macro comme celle-ci :

Sub Eclater()
Application.ScreenUpdating = False
[C2].Resize(Rows.Count - 1, 2).Delete xlUp 'RAZ
With [A1].CurrentRegion
    If .Rows.Count = 1 Then Exit Sub
    .Offset(1).Resize(.Rows.Count - 1).Copy [C2]
End With
With [C1].CurrentRegion
    .Columns(1).NumberFormat = "@" 'format Texte nécessaire s'il peut y avoir des zéros non significatifs
    .Columns(1).Replace " *", "", xlPart
    .Columns(2) = "=MID(RC1,LEN(RC[-1])+2,9^9)"
    .Columns(2) = .Columns(2).Value 'supprime les formules
    .Columns(2).Borders.Weight = xlThin
End With
End Sub

A+

 

[Staple1600]

Bonsoir le fil

Peu importe le flacon pourvu qu'on ait l'ivresse

Sub Macro1()
Dim tFo
tFo = Array(Array(1, 1), Array(2, 9), Array(3, 9), Array(4, 9), Array(5, 9))
With Selection
.TextToColumns Destination:=Range("C2"), DataType:=1, Space:=-1, FieldInfo:=tFo
.Offset(, 3).Item(1).Resize(.Rows.Count) = "=TRIM(MID(RC[-3],LEN(RC[-1])+1,9^9))"
End With
End Sub

PS: Extraire les numéros, on pouvait le faire à la minime
Mais après, bien obligé (sauf erreur de ma part) de passer par une formule.

Précisions: j'ai posté sans avoir vu le message de job75
(que je viens de juste de lire)

 

[job75]

Pour tester j'ai copié le tableau A2:A4 sur 60 000 lignes, chez moi sur Win 10 - Excel 2019 :

- macro du post #2 => 7,25 secondes

- macro du post #6 => 3,05 secondes

- macro du post #8 => 1,06 seconde

- macro du post #9 => 0,23 seconde mais les résultats sont faux…

Salut JM.

 

[Staple1600]

Re, Bonsoir job75

Je n'ai testé que sur le fichier exemple
(avec les 3 cellules de la colonne A dans ma sélection, et j'obtenais le résultat souhaité)

Mais tant mieux, si c'est faux
Parce que comme jmfmarques, je n'utiliserai pas de VBA pour faire cette séparation.

 

[Staple1600]

Re

Par acquis de conscience, j'ai aussi testé sur 60 000 lignes.
Mais je ne vois pas où le bât blesse ?
(test sur Excel 2013)

Sub Test_60000L()
Application.ScreenUpdating = False
Range("A2:A4").AutoFill Destination:=Range("A2:A60001"), Type:=xlFillDefault
Range("A2:A60001").Select
Separation
End Sub
Sub Separation()
Dim tFo
tFo = Array(Array(1, 1), Array(2, 9), Array(3, 9), Array(4, 9), Array(5, 9))
With Selection
.TextToColumns Destination:=Range("C2"), DataType:=1, Space:=-1, FieldInfo:=tFo
.Offset(, 3).Item(1).Resize(.Rows.Count) = "=TRIM(MID(RC[-3],LEN(RC[-1])+1,9^9))"
End With
End Sub

 

[laurent950]

Bonsoir,
avec les index comme demandé

Sub test()
    Dim t() As Variant, i As Integer, j As Integer
    ReDim t(1 To ActiveSheet.Cells(ActiveSheet.Cells(65535, 1).End(xlUp).Row, 1).Row - 1, 1 To 2)
    For i = LBound(t, 1) To UBound(t, 1)
    t(i, 2) = Split(ActiveSheet.Cells(i + 1, 1), " ")
        t(i, 1) = t(i, 2)(0)
        If UBound(t(i, 2)) > 2 Then
            t(i, 2) = Split(ActiveSheet.Cells(i + 1, 1), t(i, 1))(1)
        Else
        t(i, 2) = t(i, 2)(1)
        End If
    Next i
    ActiveSheet.Cells(2, 3).Resize(UBound(t, 1), UBound(t, 2)) = t
End Sub

 

[Staple1600]

Re, Bonsoir laurent950

Bonsoir,
avec les index comme demandé

?
Je ne vois pas où est cette demande.

 

[laurent950]

Merci d'éclairer ma lanterne sur le (0) de la ligne de code repérée par '***'.

C'est pas les index c'est vrais mais les positions dans la variable tableau