Macro ou formule pour extraire d'une cellule que les lettres

[CHLOE90]

Bonsoir XLD,

Je vous poste ma demande, car j'ai bien cherché dans XLD, mais pas trouvé de message qui correspond à mon problème.
Je voudrai par macro ou par formule (par formule je pense que ça sera difficile) pouvoir extraire d'une cellule qui contient des lettres des chiffres et de la ponctuation, que les lettres dans la cellule d'à coté.

Exemple cellule A1 contient 45t4§°ZIu?A, je veux obtenir en cellule B1 TZIUA

Il n'y a aucune cohérence dans les chaines de caractères, on peut rien faire avec les traditionnelles formules GAUCHE(), DROITE() ou STXT() et pas non plus avec le menu "données convertir"

Voilà, merci pour votre aide...et j'en ai des centaines comme ça.

Chloé

 

[R@chid]

Re : Macro ou formule pour extraire d'une cellule que les lettres

Bonsoir,
un essai pour les extraire sur des cellules séparées, en B1 :

=SIERREUR(STXT(MAJUSCULE($A1);PETITE.VALEUR(SI((CODE(STXT(MAJUSCULE($A1);LIGNE(INDIRECT("1:"&NBCAR($A1)));1))>64)*(CODE(STXT(MAJUSCULE($A1);LIGNE(INDIRECT("1:"&NBCAR($A1)));1))<91);LIGNE(INDIRECT("1:"&NBCAR($A1))));COLONNES($B:B));1);"")

@ valider par Ctrl+Shift+Enter
@ tirer vers la droite


@ + +


Edit : Enfin on se croise

 

[mapomme]

Re : Macro ou formule pour extraire d'une cellule que les lettres

Bonsoir CHLOE90,

Un essai avec cette fonction personnalisée:

Function Lettres(x) As String
Dim i&, C As String * 1
  For i = 1 To Len(x)
    C = UCase(Mid$(x, i, 1))
    If C >= "A" And C <= "Z" Then Lettres = Lettres & C
  Next i
End Function

Mais que faire avec les lettres accentuées ( à ,é, ü... ou ç) ?


Edit : Bonsoir R@chid

 

[CHLOE90]

Re : Macro ou formule pour extraire d'une cellule que les lettres

Bonsoir Rachid et MaPomme,

Vos deux propositions sont au top ! merci beaucoup de partager vos connaissances.
En contrepartie, voici ce que j'applique pour les caractères accentués :

Function SupprimerAccents(ByVal sChaine As String) As String
Dim sTmp As String, i As Long, p As Long
Const sCarAccent As String = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
Const sCarSansAccent As String = "AAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"
sTmp = sChaine
For i = 1 To Len(sTmp)
p = InStr(sCarAccent, Mid(sTmp, i, 1))
If p > 0 Then Mid$(sTmp, i, 1) = Mid$(sCarSansAccent, p, 1)
Next i
SupprimerAccents = sTmp
End Function

Bonne soirée à tous