Macro permettant de trier les caractère d'une phrase

[manu]

Bonjour à tous,

Je me tourne vers vous pour m'aider à trouver une solution à un poblème qui m'a été posé. Je débute en macro donc je n'ai pas beaucoup de notion.
Je voudrais creer une macro qui puisse extraire d'une phrase entrée dans une cellule les trois premier caractère de chaque mot de cette phrase, c'est à dire:

Pour la phrase: Il fait très beau aujourd'hui

En sortie: Il fai trè bea auj

En espérant trouver réponses à mon problème, je reste ouvert à toutes aides apportées
Merci

 

[ROGER2327]

Re : Macro permettant de trier les caractère d'une phrase

Bonjour manu

Une petite fonction personnalisée ?

Function toto$(s$)
Application.Volatile 'facultatif
Dim i&, r$, x
  x = Split(s)
  For i = 0 To UBound(x)
    r = r & Left$(x(i), 3) & " "
  Next
  toto = RTrim(r)
End Function

Utilisation :
=toto("Il fait très beau aujourd'hui")
ou, si le texte est en A1 :
=toto(A1)​

ROGER2327
#5126

Vendredi 27 Pédale 138 (Saint Valens, frère onirique, ST)
1er Germinal An CCXIX
2011-W12-1T09:32:37Z

__________________________
Remarque : Cette fonction ne renvoie pas d'erreur si A1 est vide.

 

[Pierrot93]

Re : Macro permettant de trier les caractère d'une phrase

Bonjour,

en supposant ta phrase en A1 de la feuille active :

Option Explicit
Sub test()
Dim t() As String, i As Byte, s As String
t = Split(Range("A1").Value)
For i = 0 To UBound(t)
    s = s & Mid(t(i), 1, 3) & " "
Next i
MsgBox Mid(s, 1, Len(s) - 1)
End Sub

bonne journée
@+

 

[JNP]

Re : Macro permettant de trier les caractère d'une phrase

Bonjour le fil 🙂,
Une fonction via RegExp

Function Découpe(Chaine As String, NbreCaractères As Integer) As String
Dim Match, Matches
Application.Volatile
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "[^\s]+"
    Set Matches = .Execute(Chaine)
    For Each Match In Matches
        Découpe = Découpe & Left(Match, NbreCaractères) & " "
    Next
End With
Découpe = Trim(Découpe)
End Function

avec la phrase en A1 et en B1

=Découpe(A1;3)

Bonne journée 😎

 

[JNP]

Re : Macro permettant de trier les caractère d'une phrase

Re 🙂,

Remarque : Cette fonction ne renvoie pas d'erreur si A1 est vide.

A priori, mais je me trompe peut-être, le simple fait de déclarer que la fonction renvoie une String empêche l'apparition d'erreur :

Function Test(MonTexte As String) As String
End Function

Ce qui parait logique, vu qu'une String déclarée, mais pas renseignée, est égale à "".
Bonne journée 😎

 

[Pierrot93]

Re : Macro permettant de trier les caractère d'une phrase

Re, bonjour Roger, JNP

modification du code proposé afin d'éviter l'erreur si A1 est vide :

Option Explicit
Sub test()
Dim t() As String, i As Byte, s As String
t = Split(Range("A1").Value)
If UBound(t) < 0 Then Exit Sub
For i = 0 To UBound(t)
    s = s & Mid(t(i), 1, 3) & " "
Next i
MsgBox Mid(s, 1, Len(s) - 1)
End Sub

 

[manu]

Re : Macro permettant de trier les caractère d'une phrase

Bonjour, merci pour toutes vos réponses, je viens d'essayer la deuxième solutions qui m'ai été transmis, elle fonctionne et j'en suis ravi.
J'aimerais savoir si c'est possible que au lieu que la fonction me sorte la solution dans une case de dialogue, elle écrase directement la phrase présente dans la cellule?
Merci

 

[ROGER2327]

Re : Macro permettant de trier les caractère d'une phrase

Bonjour JNP

Essayez la première solution de Pierrot93 (bonjour !), et vous comprendrez peut-être le sens de la remarque.​

ROGER2327
#5127

Vendredi 27 Pédale 138 (Saint Valens, frère onirique, ST)
1er Germinal An CCXIX
2011-W12-1T10:10:39Z

 

[Pierrot93]

Re : Macro permettant de trier les caractère d'une phrase

Re,

modifie ainsi :

Option Explicit
Sub test()
Dim t() As String, i As Byte, s As String
t = Split(Range("A1").Value)
If UBound(t) < 0 Then Exit Sub
For i = 0 To UBound(t)
    s = s & Mid(t(i), 1, 3) & " "
Next i
Range("A1").Value = Mid(s, 1, Len(s) - 1)
End Sub

 

[JNP]

Re : Macro permettant de trier les caractère d'une phrase

Re 🙂,
Bonjour Roger 🙂,

Essayez la première solution de Pierrot93 (bonjour !), et vous comprendrez peut-être le sens de la remarque.

Oui, effectivement, désolé, ma remarque était plus sur les fonctions personalisées en général 😱...
Bonne journée 😎

 

[manu]

Re : Macro permettant de trier les caractère d'une phrase

Je n'arrive pas à utiliser les fonctions VBA, il ne prend pas en compte l'intégration de la fonction dans la cellule.
Pour le deuxième code, sii je souhaite que ça se fasse de façon automatique, c'est à dire dès la saisie de la phrase dans la cellule.

 

[Pierrot93]

Re : Macro permettant de trier les caractère d'une phrase

Re,

dans ce cas placer le code dans le module de la feuille concernée et le modifier comme suit, contrôle la modification de la cellule A1 :

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t() As String, i As Byte, s As String
If Target.Address <> "$A$1" Then Exit Sub
t = Split(Target.Value)
If UBound(t) < 0 Then Exit Sub
For i = 0 To UBound(t)
    s = s & Mid(t(i), 1, 3) & " "
Next i
Target.Value = Mid(s, 1, Len(s) - 1)
End Sub

 

[manu]

Re : Macro permettant de trier les caractère d'une phrase

C'est bon j'ai réussi à automatiser la macro en revanche connaissez vous une méthode pour appliquer la macro à toutes la colonne?

 

[Pierrot93]

Re : Macro permettant de trier les caractère d'une phrase

Re,

pour application sur la colonne A :

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t() As String, i As Byte, s As String
If Target.Column > 1 Or Target.Count > 1 Then Exit Sub
t = Split(Target.Value)
If UBound(t) < 0 Then Exit Sub
For i = 0 To UBound(t)
    s = s & Mid(t(i), 1, 3) & " "
Next i
Target.Value = Mid(s, 1, Len(s) - 1)
End Sub

Edition : rajouté un test sur le nombre de cellules "Target.Count "

 

[manu]

Re : Macro permettant de trier les caractère d'une phrase

Merci beaucoup pour tes réponses PIERROT93.
Je regrette pas de mettre inscrit sur ce site