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

 

[cp4]

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)

Bonjour Staple1600 ,

Je viens de tester ton code. Il ne donne pas le bon résultat. Si j'ai bien compris il faut au préalable sélectionner la plage contenant le données car il y a "with selection".
Merci quand même pour ton intervention.
Bonne journée.

edit: il y a eu tellement de réponses que je me suis embrouillé. Le code fonctionne bien. Merci

 

[cp4]

bonsoir le fil

Sub test()
    Dim I&, Chaine$
    For I = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        chaine = Cells(I, 1).Value
        If InStr(chaine, " ") > 0 Then'on prevois quand même le cas ou il n'y a pas d'espace
            Cells(I, "C").Resize(, 2) = Array(Trim(Mid(chaine, 1, InStr(1, chaine, " "))), Trim(Mid(chaine, InStr(1, chaine, " "))))
        Else
            Cells(I, "C") = chaine
        End If
    Next
End Sub

Bonjour PatrickToulon,

Ton code est parfait, enfin à mon sens car tous les résultats sont bons.
Je sais pas qu'en pensent les "grosses pointures" du forum.
Merci beaucoup.

Merci à vous tous pour votre participation, à la prochaine!

 

[patricktoulon]

Bonjour Cp4
la méthode de job (formule)est plus rapide en effet mais il lui manque les exceptions
ligne vides/ pas d'espaces

en testant instr(" ") sur la chaîne on a ces deux gestion en une

hiers j'ai repris la formule de job75
les valeurs en A1 les nombre s en C et le reste en D

Sub Eclater2()
'reprise du code de job75 'patrick
Application.ScreenUpdating = False
[C2].Resize(Rows.Count - 1, 2).Delete xlUp 'RAZ
With [A1].Resize(Cells(Rows.Count, 1).End(xlUp).Row) 'prise en compte du tableau a partir de A1  jusqu'à dernière pleine
    If .Rows.Count = 1 Then Exit Sub
        'ajout de la condition vide
        .Offset(0, 2).Value = "=IF(ISBLANK(RC[-2])=FALSE,LEFT(RC[-2],FIND("" "",RC[-2])-1),"""")"
        .Offset(0, 3).Value = "=IF(ISBLANK(RC[-3])=FALSE,MID(RC1,LEN(RC[-1])+2,9^9),"""")"
        .Offset(0, 2).Resize(, 2).Borders.Weight = xlThin
    'manque la condition (pas d'espace pour  couper)
End With
End Sub

'manque la condition (pas d'espace pour couper)
et on aura le même résultat

 

[cp4]

Bonjour Cp4
la méthode de job (formule)est plus rapide en effet mais il lui manque les exceptions
ligne vides/ pas d'espaces

en testant instr(" ") sur la chaîne on a ces deux gestion en une

hiers j'ai repris la formule de job75
les valeurs en A1 les nombre s en C et le reste en D

Sub Eclater2()
'reprise du code de job75 'patrick
Application.ScreenUpdating = False
[C2].Resize(Rows.Count - 1, 2).Delete xlUp 'RAZ
With [A1].Resize(Cells(Rows.Count, 1).End(xlUp).Row) 'prise en compte du tableau a partir de A1  jusqu'à dernière pleine
    If .Rows.Count = 1 Then Exit Sub
        'ajout de la condition vide
        .Offset(0, 2).Value = "=IF(ISBLANK(RC[-2])=FALSE,LEFT(RC[-2],FIND("" "",RC[-2])-1),"""")"
        .Offset(0, 3).Value = "=IF(ISBLANK(RC[-3])=FALSE,MID(RC1,LEN(RC[-1])+2,9^9),"""")"
        .Offset(0, 2).Resize(, 2).Borders.Weight = xlThin
    'manque la condition (pas d'espace pour  couper)
End With
End Sub

'manque la condition (pas d'espace pour couper)
et on aura le même résultat

Re PatrickToulon ,
Je n'attendais pas à autant pour mon petit problème.
Merci beaucoup, ma reconnaissance et ma gratitude.

Bonne journée.

 

[patricktoulon]

re
si je garde mon principe a savoir la condition instr espace >0 mais que j'utilise l'inscription de formule de job75
ca donne ceci:

Sub Eclater2()
'reprise de  patrick
    Application.ScreenUpdating = False
    With [A1].Resize(Cells(Rows.Count, 1).End(xlUp).Row)    'prise en compte du tableau a partir de A1  jusqu'à derniere pleine
        .Offset(, 2).Resize(, 2).ClearContents
        If .Rows.Count = 1 Then Exit Sub
        'ajout de la condition like espace qui gere les vides en meme temps
        .Offset(0, 2).Value = "=IFERROR( LEFT(RC[-2],FIND("" "",rc1)-1),"""")"
        .Offset(0, 3).Value = "=IF(RC[-1]<>"""",MID(RC1,LEN(RC[-1])+2,9^9),"""")"
        .Offset(0, 2).Resize(, 2).Borders.Weight = xlThin
        'manque la condition (pas d'espace pour  couper)
    End With
End Sub

 

[job75]

la méthode de job (formule)est plus rapide en effet mais il lui manque les exceptions
ligne vides/ pas d'espaces

Vraiment très grosse propention à enc… les mouches

Un utilisateur normalement constitué n'a aucune raison de laisser des cellules vides en colonne A.

Et s'il n'y a pas d'espace il s'agit alors d'une grosière erreur, les formules la mettent en évidence.

 

[cp4]

Vraiment très grosse propention à enc… les mouches

Un utilisateur normalement constitué n'a aucune raison de laisser des cellules vides en colonne A.

Et s'il n'y a pas d'espace il s'agit alors d'une grosière erreur, les formules la mettent en évidence.

Bonjour Job75 ,

Je pense que ce n'est pas une mauvaise idée de considérer la présence de lignes vides. Car les données sont extraites du web, du coup, en effet il peut y avoir de lignes vides.

Encore merci pour ton aide et ta pertinence .
Il est bientôt midi. Bon appétit.

 

[patricktoulon]

perso c'est les mouches bleues d'ALASKA mes préférées elles ont un popotin bien dodu

 

[job75]

Je pense que ce n'est pas une mauvaise idée de considérer la présence de lignes vides. Car les données sont extraites du web, du coup, en effet il peut y avoir de lignes vides.

D'accord mais alors ça ne mange pas de pain de faire un petit nettoyage :

On Error Resume Next
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

 

[patricktoulon]

re
et si plus loin dans les colonnes il y a d'autres données voir d'autres tableaux
il faut arrêter les moustiques essaie les mouches

 

[job75]

OK pour les mouches s'il y a plusieurs tableaux :

Sub Eclater2()
Application.ScreenUpdating = False
With Range("A1", ActiveSheet.UsedRange)
    Intersect(.EntireRow, [C:D]).Delete xlUp 'RAZ
    With [C1].Resize(.Rows.Count)
        .FormulaR1C1 = "=IF(LEFT(RC1,7)=""Tableau"",RC1,LEFT(RC1,FIND("" "",RC1&"" "")-1))"
        .Columns(2) = "=MID(RC1,LEN(RC[-1])+2,9^9)"
    End With
End With
End Sub

Fichier (2).

 

[Staple1600]

Bonsoir le fil

Car les données sont extraites du web, du coup, en effet il peut y avoir de lignes vides.

Imaginons que...les données s'affichent ainsi sur le web

N°	Chaînes
10	Mangas
258	RAI Uno
13	TMC Hd

Alors CTRL+C puis dans Excel Collage spécial -> HTML
Et O joie O Bonheur
Et si vraiment trop fainénant pour un copier/coller à la mimine
alors l'équivalent VBA

Sub Macro1()
ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
End Sub

 

[patricktoulon]

re
@Staple1600
si données copiées dans la web source paste tout court fait la même chose 2007 2013
si style= inline alors le style aussi
si style =computedstyle(dans balise style) alors style perdu

 

[Staple1600]

Bonsoir patricktoulon

On se fiche du style
L’intérêt c'est juste que la séparation se fasse lors du collage spécial.
(Puisque c'était la question initiale)
Donc tant mieux si un simple
CTRL+A
CTRL+C
CTRL+V fait l'affaire