[RESOLU] Copier à la ligne la valeur qui précède une ponctuation

  • Initiateur de la discussion Initiateur de la discussion teecaf
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

teecaf

XLDnaute Nouveau
Bonsoir le forum,

J'ai une une nouvelle problématique (du moins pour moi) à vous soumettre.

Voilà, je voudrais par VBA copier toute valeur précédée d'une ponctuation (. , ; -) à la ligne automatiquement en cliquant sur un bouton qui déclencherait la procédure.

Je vous joins un classeur avec un exemple de phrase (recette de cuisine) et ce que j'aimerai que cela fasse.
Il faudrait extraire la liste des ingrédients dans une seule phrase et je souhaiterai qu'a chaque ingrédient on passe directement à la ligne et on copie le mot qui précède le signe de ponctuation (ex: poivre, oeuf, ).

poivre
oeuf

Merci pour votre aide.

Cordialement.

Teecaf
 

Pièces jointes

Dernière édition:
Re : [RESOLU] Copier à la ligne la valeur qui précède une ponctuation

Bonsoir teecaf, Pierre,

Autre solution :

Code:
Private Sub CommandButton1_Click()
MettreEnLignes [A4], [A12] 'paramètres à adapter
End Sub

Sub MettreEnLignes(source$, dest As Range)
Dim p, s
For Each p In Array(":", ".", ",", ";")
  source = Replace(source, p, Chr(1))
Next
s = Split(source, Chr(1))
For p = 0 To UBound(s)
  s(p) = Trim(s(p))
Next
If p Then dest.Resize(p, 1) = Application.Transpose(s)
dest(p + 1).Resize(Rows.Count - dest.Row - p + 1, 1) = ""
End Sub
Fichier joint.

Edit : devant "courgette" il y a un espace insécable de code 160, il n'est donc pas supprimé...

A+
 

Pièces jointes

Dernière édition:
Re : [RESOLU] Copier à la ligne la valeur qui précède une ponctuation

Re,

S'il y a plusieurs textes à mettre en lignes :

Code:
Private Sub CommandButton1_Click()
Dim c As Range
[A7:A65536].Clear 'RAZ
For Each c In [A4:A6] 'plage à adapter
  MettreEnLignes c.Value, Range("A" & Rows.Count).End(xlUp)(3)
Next
End Sub

Sub MettreEnLignes(source$, dest As Range)
Dim p, s
For Each p In Array(":", ".", ",", ";")
  source = Replace(source, p, Chr(1))
Next
s = Split(source, Chr(1))
For p = 0 To UBound(s)
  s(p) = Trim(s(p))
Next
If p Then
  dest.Font.Bold = True 'gras
  dest.Font.ColorIndex = 3 'rouge
  dest.Resize(p) = Application.Transpose(s)
End If
End Sub
Fichier (2).

Bonne nuit.
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour