Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Découper du texte a l'aide d'une macro

Découper du texte a l'aide d'une macro

27 réponses
Avatar
Perceval973
Bonjour tout le monde :-)

J'ai un tableau avec du texte dans les cellules B4 à B50
Ce texte est ecrit sous la forme :
"texte1 - texte A"
"texte2 - texte B"
"texte3 - texte C"
"texte4 - texte D"

Le "textenum" est différent d'une cellume a l'autre, le "textelettre" est
différent lui aussi.
La seule constante est que ces textes sont systématiquement séparés par
"espace-tiret-espace"

mon probleme est le suivant :
Je voudrais a l'aide d'une macro couper tous les "textenum" et les coller
dans les cellules A4 à A50 pour avoir
de A4 à A50 :
Texte1
Texte2
Texte3
Texte4 etc..

Et de B4 à B50 :
Texte A
Texte B
Texte C
Texte D etc..

Et supprimer tous les "espace-tiret-espace"

Est-ce possible avec mes maigres connaissances ?
Merci pour votre aide
Perceval
Signaler un problème avec ce contenu

7 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3
Avatar
Pounet95
Re,
Par prudence toujours, recopie ta feuille dans une autre.
A adpter si besoin
Essaie ceci :


Sub Découpage()
Range("B4").Select
Do While ActiveCell.Value <> ""
nb = UBound(Split(ActiveCell.Value, "-", -1))
If nb = 1 Then
wSepare = InStr(ActiveCell.Value, "-")
Else
msg = "2 délimiteurs pour :" & Chr(10) & ActiveCell.Value _
& Chr(10) & "Découper au 1er ou au 2ème ?"
rep = InputBox(msg)
Select Case rep
Case ""
Exit Sub
Case 1
wSepare = InStr(ActiveCell.Value, "-")
Case 2
wSepare = InStr(ActiveCell.Value, "-")
wSepare = InStr(wSepare + 1, ActiveCell.Value, "-")
Case Else
Exit Sub
End Select
End If
wGauche = Mid$(ActiveCell.Value, 1, wSepare - 2)
wDroite = Mid$(ActiveCell.Value, wSepare + 2, _
Len(ActiveCell.Value) - wSepare - 2)
ActiveCell.Offset(0, -1).Value = wGauche
ActiveCell.Value = wDroite
ActiveCell.Offset(1, 0).Select
Loop
End Sub


--
Pounet95
on trouve tout ( ou presque ) http://www.excelabo.net/


"Perceval973" a écrit dans le message de news:
41b5c3bd$0$18823$
Bonjour tout le monde :-)

J'ai un tableau avec du texte dans les cellules B4 à B50
Ce texte est ecrit sous la forme :
"texte1 - texte A"
"texte2 - texte B"
"texte3 - texte C"
"texte4 - texte D"

Le "textenum" est différent d'une cellume a l'autre, le "textelettre" est
différent lui aussi.
La seule constante est que ces textes sont systématiquement séparés par
"espace-tiret-espace"

mon probleme est le suivant :
Je voudrais a l'aide d'une macro couper tous les "textenum" et les coller
dans les cellules A4 à A50 pour avoir
de A4 à A50 :
Texte1
Texte2
Texte3
Texte4 etc..

Et de B4 à B50 :
Texte A
Texte B
Texte C
Texte D etc..

Et supprimer tous les "espace-tiret-espace"

Est-ce possible avec mes maigres connaissances ?
Merci pour votre aide
Perceval




Avatar
Clément Marcotte
Bonjour,

Cela marche avec ton fichier sur cjoint.com

Sub DroiteGauche()
Dim derniereligne As Long, i As Long
Dim letexte As String, agauche As String
Dim adroite As String
derniereligne = Range("b65536").End(xlUp).Row
For i = 4 To derniereligne
letexte = Cells(i, 2).Value
lacoupe = InStr(letexte, "-")
agauche = Trim(Left(letexte, lacoupe - 1))
adroite = Trim(Right(letexte, Len(letexte) - lacoupe))
Cells(i, 1).Value = agauche
Cells(i, 2).Value = adroite
Next
End Sub


"Perceval973" a écrit dans le message de
news:41b5c3bd$0$18823$
Bonjour tout le monde :-)

J'ai un tableau avec du texte dans les cellules B4 à B50
Ce texte est ecrit sous la forme :
"texte1 - texte A"
"texte2 - texte B"
"texte3 - texte C"
"texte4 - texte D"

Le "textenum" est différent d'une cellume a l'autre, le
"textelettre" est

différent lui aussi.
La seule constante est que ces textes sont systématiquement séparés
par

"espace-tiret-espace"

mon probleme est le suivant :
Je voudrais a l'aide d'une macro couper tous les "textenum" et les
coller

dans les cellules A4 à A50 pour avoir
de A4 à A50 :
Texte1
Texte2
Texte3
Texte4 etc..

Et de B4 à B50 :
Texte A
Texte B
Texte C
Texte D etc..

Et supprimer tous les "espace-tiret-espace"

Est-ce possible avec mes maigres connaissances ?
Merci pour votre aide
Perceval




Avatar
Perceval973
Merci :-)
Je testerais ca des demain matin ;-)

"Pounet95" a écrit dans le message de news:

Re,
Par prudence toujours, recopie ta feuille dans une autre.
A adpter si besoin
Essaie ceci :


Sub Découpage()
Range("B4").Select
Do While ActiveCell.Value <> ""
nb = UBound(Split(ActiveCell.Value, "-", -1))
If nb = 1 Then
wSepare = InStr(ActiveCell.Value, "-")
Else
msg = "2 délimiteurs pour :" & Chr(10) & ActiveCell.Value _
& Chr(10) & "Découper au 1er ou au 2ème ?"
rep = InputBox(msg)
Select Case rep
Case ""
Exit Sub
Case 1
wSepare = InStr(ActiveCell.Value, "-")
Case 2
wSepare = InStr(ActiveCell.Value, "-")
wSepare = InStr(wSepare + 1, ActiveCell.Value, "-")
Case Else
Exit Sub
End Select
End If
wGauche = Mid$(ActiveCell.Value, 1, wSepare - 2)
wDroite = Mid$(ActiveCell.Value, wSepare + 2, _
Len(ActiveCell.Value) - wSepare - 2)
ActiveCell.Offset(0, -1).Value = wGauche
ActiveCell.Value = wDroite
ActiveCell.Offset(1, 0).Select
Loop
End Sub


--
Pounet95
on trouve tout ( ou presque ) http://www.excelabo.net/


"Perceval973" a écrit dans le message de news:
41b5c3bd$0$18823$
Bonjour tout le monde :-)

J'ai un tableau avec du texte dans les cellules B4 à B50
Ce texte est ecrit sous la forme :
"texte1 - texte A"
"texte2 - texte B"
"texte3 - texte C"
"texte4 - texte D"

Le "textenum" est différent d'une cellume a l'autre, le "textelettre" est
différent lui aussi.
La seule constante est que ces textes sont systématiquement séparés par
"espace-tiret-espace"

mon probleme est le suivant :
Je voudrais a l'aide d'une macro couper tous les "textenum" et les coller
dans les cellules A4 à A50 pour avoir
de A4 à A50 :
Texte1
Texte2
Texte3
Texte4 etc..

Et de B4 à B50 :
Texte A
Texte B
Texte C
Texte D etc..

Et supprimer tous les "espace-tiret-espace"

Est-ce possible avec mes maigres connaissances ?
Merci pour votre aide
Perceval







Avatar
Perceval973
Salut tout le monde

Pounet95 je viens de tester ta proposition...
Ca marche super bien...
J'ai pas encore essayé les propositions des autres participants... Je ferais
ca demain

Merci a tous
Perceval

"Pounet95" a écrit dans le message de
news:
Re,
Par prudence toujours, recopie ta feuille dans une autre.
A adpter si besoin
Essaie ceci :


Sub Découpage()
Range("B4").Select
Do While ActiveCell.Value <> ""
nb = UBound(Split(ActiveCell.Value, "-", -1))
If nb = 1 Then
wSepare = InStr(ActiveCell.Value, "-")
Else
msg = "2 délimiteurs pour :" & Chr(10) & ActiveCell.Value _
& Chr(10) & "Découper au 1er ou au 2ème ?"
rep = InputBox(msg)
Select Case rep
Case ""
Exit Sub
Case 1
wSepare = InStr(ActiveCell.Value, "-")
Case 2
wSepare = InStr(ActiveCell.Value, "-")
wSepare = InStr(wSepare + 1, ActiveCell.Value, "-")
Case Else
Exit Sub
End Select
End If
wGauche = Mid$(ActiveCell.Value, 1, wSepare - 2)
wDroite = Mid$(ActiveCell.Value, wSepare + 2, _
Len(ActiveCell.Value) - wSepare - 2)
ActiveCell.Offset(0, -1).Value = wGauche
ActiveCell.Value = wDroite
ActiveCell.Offset(1, 0).Select
Loop
End Sub


--
Pounet95
on trouve tout ( ou presque ) http://www.excelabo.net/


"Perceval973" a écrit dans le message de news:
41b5c3bd$0$18823$
Bonjour tout le monde :-)

J'ai un tableau avec du texte dans les cellules B4 à B50
Ce texte est ecrit sous la forme :
"texte1 - texte A"
"texte2 - texte B"
"texte3 - texte C"
"texte4 - texte D"

Le "textenum" est différent d'une cellume a l'autre, le "textelettre"
est


différent lui aussi.
La seule constante est que ces textes sont systématiquement séparés par
"espace-tiret-espace"

mon probleme est le suivant :
Je voudrais a l'aide d'une macro couper tous les "textenum" et les
coller


dans les cellules A4 à A50 pour avoir
de A4 à A50 :
Texte1
Texte2
Texte3
Texte4 etc..

Et de B4 à B50 :
Texte A
Texte B
Texte C
Texte D etc..

Et supprimer tous les "espace-tiret-espace"

Est-ce possible avec mes maigres connaissances ?
Merci pour votre aide
Perceval







Avatar
Perceval973
Encore une dernière petite chose :-S
Ta macro marche super bien sauf qu'elle supprime le dernier carctère de
chaque ligne dans la colonne B

"Pounet95" a écrit dans le message de
news:
Re,
Par prudence toujours, recopie ta feuille dans une autre.
A adpter si besoin
Essaie ceci :


Sub Découpage()
Range("B4").Select
Do While ActiveCell.Value <> ""
nb = UBound(Split(ActiveCell.Value, "-", -1))
If nb = 1 Then
wSepare = InStr(ActiveCell.Value, "-")
Else
msg = "2 délimiteurs pour :" & Chr(10) & ActiveCell.Value _
& Chr(10) & "Découper au 1er ou au 2ème ?"
rep = InputBox(msg)
Select Case rep
Case ""
Exit Sub
Case 1
wSepare = InStr(ActiveCell.Value, "-")
Case 2
wSepare = InStr(ActiveCell.Value, "-")
wSepare = InStr(wSepare + 1, ActiveCell.Value, "-")
Case Else
Exit Sub
End Select
End If
wGauche = Mid$(ActiveCell.Value, 1, wSepare - 2)
wDroite = Mid$(ActiveCell.Value, wSepare + 2, _
Len(ActiveCell.Value) - wSepare - 2)
ActiveCell.Offset(0, -1).Value = wGauche
ActiveCell.Value = wDroite
ActiveCell.Offset(1, 0).Select
Loop
End Sub


--
Pounet95
on trouve tout ( ou presque ) http://www.excelabo.net/


"Perceval973" a écrit dans le message de news:
41b5c3bd$0$18823$
Bonjour tout le monde :-)

J'ai un tableau avec du texte dans les cellules B4 à B50
Ce texte est ecrit sous la forme :
"texte1 - texte A"
"texte2 - texte B"
"texte3 - texte C"
"texte4 - texte D"

Le "textenum" est différent d'une cellume a l'autre, le "textelettre"
est


différent lui aussi.
La seule constante est que ces textes sont systématiquement séparés par
"espace-tiret-espace"

mon probleme est le suivant :
Je voudrais a l'aide d'une macro couper tous les "textenum" et les
coller


dans les cellules A4 à A50 pour avoir
de A4 à A50 :
Texte1
Texte2
Texte3
Texte4 etc..

Et de B4 à B50 :
Texte A
Texte B
Texte C
Texte D etc..

Et supprimer tous les "espace-tiret-espace"

Est-ce possible avec mes maigres connaissances ?
Merci pour votre aide
Perceval







Avatar
Pounet95
Bonjour,
Modifie la ligne de calcul de wDroite comme suit :

wDroite = Mid$(ActiveCell.Value, wSepare + 2, _
Len(ActiveCell.Value) - wSepare - 1)

C'est -1 à la fin au lieu de -2 !
--
Pounet95
on trouve tout ( ou presque ) http://www.excelabo.net/

"Perceval973" a écrit dans le message de news:
41b85826$0$20821$
Encore une dernière petite chose :-S
Ta macro marche super bien sauf qu'elle supprime le dernier carctère de
chaque ligne dans la colonne B

"Pounet95" a écrit dans le message de
news:
Re,
Par prudence toujours, recopie ta feuille dans une autre.
A adpter si besoin
Essaie ceci :


Sub Découpage()
Range("B4").Select
Do While ActiveCell.Value <> ""
nb = UBound(Split(ActiveCell.Value, "-", -1))
If nb = 1 Then
wSepare = InStr(ActiveCell.Value, "-")
Else
msg = "2 délimiteurs pour :" & Chr(10) & ActiveCell.Value _
& Chr(10) & "Découper au 1er ou au 2ème ?"
rep = InputBox(msg)
Select Case rep
Case ""
Exit Sub
Case 1
wSepare = InStr(ActiveCell.Value, "-")
Case 2
wSepare = InStr(ActiveCell.Value, "-")
wSepare = InStr(wSepare + 1, ActiveCell.Value, "-")
Case Else
Exit Sub
End Select
End If
wGauche = Mid$(ActiveCell.Value, 1, wSepare - 2)
wDroite = Mid$(ActiveCell.Value, wSepare + 2, _
Len(ActiveCell.Value) - wSepare - 2)
ActiveCell.Offset(0, -1).Value = wGauche
ActiveCell.Value = wDroite
ActiveCell.Offset(1, 0).Select
Loop
End Sub


--
Pounet95
on trouve tout ( ou presque ) http://www.excelabo.net/


"Perceval973" a écrit dans le message de news:
41b5c3bd$0$18823$
Bonjour tout le monde :-)

J'ai un tableau avec du texte dans les cellules B4 à B50
Ce texte est ecrit sous la forme :
"texte1 - texte A"
"texte2 - texte B"
"texte3 - texte C"
"texte4 - texte D"

Le "textenum" est différent d'une cellume a l'autre, le "textelettre"
est


différent lui aussi.
La seule constante est que ces textes sont systématiquement séparés par
"espace-tiret-espace"

mon probleme est le suivant :
Je voudrais a l'aide d'une macro couper tous les "textenum" et les
coller


dans les cellules A4 à A50 pour avoir
de A4 à A50 :
Texte1
Texte2
Texte3
Texte4 etc..

Et de B4 à B50 :
Texte A
Texte B
Texte C
Texte D etc..

Et supprimer tous les "espace-tiret-espace"

Est-ce possible avec mes maigres connaissances ?
Merci pour votre aide
Perceval











Avatar
Perceval973
Super ca marche :-)
Encore merci

"Pounet95" a écrit dans le message de
news:
Bonjour,
Modifie la ligne de calcul de wDroite comme suit :

wDroite = Mid$(ActiveCell.Value, wSepare + 2, _
Len(ActiveCell.Value) - wSepare - 1)

C'est -1 à la fin au lieu de -2 !
--
Pounet95
on trouve tout ( ou presque ) http://www.excelabo.net/

"Perceval973" a écrit dans le message de news:
41b85826$0$20821$
Encore une dernière petite chose :-S
Ta macro marche super bien sauf qu'elle supprime le dernier carctère de
chaque ligne dans la colonne B

"Pounet95" a écrit dans le message de
news:
Re,
Par prudence toujours, recopie ta feuille dans une autre.
A adpter si besoin
Essaie ceci :


Sub Découpage()
Range("B4").Select
Do While ActiveCell.Value <> ""
nb = UBound(Split(ActiveCell.Value, "-", -1))
If nb = 1 Then
wSepare = InStr(ActiveCell.Value, "-")
Else
msg = "2 délimiteurs pour :" & Chr(10) & ActiveCell.Value _
& Chr(10) & "Découper au 1er ou au 2ème ?"
rep = InputBox(msg)
Select Case rep
Case ""
Exit Sub
Case 1
wSepare = InStr(ActiveCell.Value, "-")
Case 2
wSepare = InStr(ActiveCell.Value, "-")
wSepare = InStr(wSepare + 1, ActiveCell.Value, "-")
Case Else
Exit Sub
End Select
End If
wGauche = Mid$(ActiveCell.Value, 1, wSepare - 2)
wDroite = Mid$(ActiveCell.Value, wSepare + 2, _
Len(ActiveCell.Value) - wSepare - 2)
ActiveCell.Offset(0, -1).Value = wGauche
ActiveCell.Value = wDroite
ActiveCell.Offset(1, 0).Select
Loop
End Sub


--
Pounet95
on trouve tout ( ou presque ) http://www.excelabo.net/


"Perceval973" a écrit dans le message de news:
41b5c3bd$0$18823$
Bonjour tout le monde :-)

J'ai un tableau avec du texte dans les cellules B4 à B50
Ce texte est ecrit sous la forme :
"texte1 - texte A"
"texte2 - texte B"
"texte3 - texte C"
"texte4 - texte D"

Le "textenum" est différent d'une cellume a l'autre, le "textelettre"
est


différent lui aussi.
La seule constante est que ces textes sont systématiquement séparés
par




"espace-tiret-espace"

mon probleme est le suivant :
Je voudrais a l'aide d'une macro couper tous les "textenum" et les
coller


dans les cellules A4 à A50 pour avoir
de A4 à A50 :
Texte1
Texte2
Texte3
Texte4 etc..

Et de B4 à B50 :
Texte A
Texte B
Texte C
Texte D etc..

Et supprimer tous les "espace-tiret-espace"

Est-ce possible avec mes maigres connaissances ?
Merci pour votre aide
Perceval














1 2 3