Separation consonnes d'un mot

Bonjour je souhaiterais séparer les consonnes d'un mot.

Voici quelques exemples :

Lundi>>>>Lnd

Armoire>>>>Armr

Gouttière>>>>Gttr

Étoile>>>>Etl

La macro ci dessous (que j'ai trouvé sur le forum) permet d'extraire d'un mot la première lettre (quel soit une voyelle ou une consonne) et les trois consonnes suivantes. J'ai trouvé comment modifier le nombre de consonnes à extraire. Mais je n'ai toujours pas réussi à modifier le code pour que l’extraction de la première lettre soit toujours une consonne....

Je vous remercie pour votre aide.

Option Explicit
Function Consonne(Valeur) As String
Dim Longueur As Byte
Dim i As Byte
Dim Caractere As String
Consonne = Left(Valeur, 1)
Longueur = Len(Valeur)
For i = 2 To Longueur
Caractere = Mid$(Valeur, i, 1)
If Caractere <> "a" And Caractere <> "e" And Caractere <> "i" _
And Caractere <> "o" And Caractere <> "u" And Caractere <> "y" Then
Consonne = Consonne & Caractere
End If
If Len(Consonne) = 4 Then Exit Function
Next i
End Function

Bonjour,

essaie ceci, non testé

Option Explicit
Function Consonne(Valeur) As String
Dim Longueur As Byte
Dim i As Byte
Dim Caractere As String
Consonne = ""
Longueur = Len(Valeur)
For i = 1 To Longueur
Caractere = Mid$(Valeur, i, 1)
If Caractere <> "a" And Caractere <> "e" And Caractere <> "i" _
And Caractere <> "o" And Caractere <> "u" And Caractere <> "y" Then
Consonne = Consonne & Caractere
End If
If Len(Consonne) = 4 Then Exit Function
Next i
End Function
 

Bonjour à tous,

Pas de besoin de macro ...

James007 ton code répond parfaitement à ma demande mais ce que j'ai oublié de dire , c'est que j'utilise des mots composés avec espaces tirets et apostrophe ainsi que des lettres avec accents....

J'avais presque réussi à modeler la macro ci dessous avec le bout de code suivant (merci à Theze) qui me permet de remplir les conditions complémentaires énoncés ci dessus :

Private Function RemplacerAccent(Chaine As String) As String

    Dim I As Long

    Chaine = Replace(Chaine, "à", "a")
    Chaine = Replace(Chaine, "â", "a")
    Chaine = Replace(Chaine, "ä", "a")

    Chaine = Replace(Chaine, "é", "e")
    Chaine = Replace(Chaine, "è", "e")
    Chaine = Replace(Chaine, "ê", "e")
    Chaine = Replace(Chaine, "ë", "e")

    Chaine = Replace(Chaine, "î", "i")
    Chaine = Replace(Chaine, "ï", "i")

    Chaine = Replace(Chaine, "ô", "o")
    Chaine = Replace(Chaine, "ö", "o")

    Chaine = Replace(Chaine, "ù", "u")
    Chaine = Replace(Chaine, "û", "u")
    Chaine = Replace(Chaine, "ü", "u")

    Chaine = Replace(Chaine, "ç", "c")

    Chaine = Replace(Chaine, " ", "")
    Chaine = Replace(Chaine, "'", "")
    Chaine = Replace(Chaine, "-", "")

    RemplacerAccent = Chaine

End Function

H2so4,

J'avais testé cette modif sans succès

Re,

Du coup, une fonction personnalisée ... dans laquelle tu peux gérer le casse-tête de tous les accents ...

C'est presque ça!

Il faudrait que je remplace le tiret et l'apostrophe par un espace et ça sera nickel!

bagheera a écrit :

C'est presque ça!

Il faudrait que je remplace le tiret et l'apostrophe par un espace et ça sera nickel!

Ravi que tu aies la solution à ton problème ...

H2so4,

J'avais testé cette modif sans succès [/quote]

Ravi que tu aies une solution qui te conviennes, mais après l'avoir testée, la solution que je t'ai proposée fonctionne parfaitement.

merci