XL 2013 extraire les premières lettres d'une chaine de caractère

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion kabamel
  • 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 !

S'inscrire
K

kabamel

XLDnaute Occasionnel
Salut à tous, comme dans le titre, J'ai besoin avec une fonction d'extraire les premières lettres d'une chaine dans une cellule. Mais les mots : "DES"; "DE"; "DU"; "D'"; "LES"; "LE"; "L'" et autres caractères comme "&" ne font pas partie. Par exemple : "Société d'Extraction de pétrole français" il m'envoie "SEPF". Merci pour aide.
 
Trier par date Trier par votes
Bonjour le forum

Un essai en formule avec 3 colonnes
en A1
Société d'Extraction de pétrole français
en B1
Code: 
=SUBSTITUE(SUBSTITUE(A1;"d'";"");"de";"")
en C1
Code: 
=MAJUSCULE(SUBSTITUE(GAUCHE(B1)&STXT(B1;TROUVE("$";SUBSTITUE(B1&"  ";" ";"$";1))+1;1)&STXT(B1;TROUVE("$";SUBSTITUE(B1&"  ";" ";"$";2))+1;1)&STXT(B1;TROUVE("$";SUBSTITUE(B1&"  ";" ";"$";3))+1;1)&STXT(B1;TROUVE("$";SUBSTITUE(B1&"  ";" ";"$";4))+1;1);" ";""))
La formule en C1 renvoie SEPF
 
Vote positif 0 Vote négatif
kabamel à dit:
Salut à tous, comme dans le titre, J'ai besoin avec une fonction d'extraire les premières lettres d'une chaine dans une cellule.
Cliquez pour agrandir...
Bonjour,
A tester...une fonction perso...
VB: 
Function Sigle(Y As Range) As String
    Dim X As String, A As String, i As Long
    X = Y.Value
    X = Replace(X, " du ", " ")
    X = Replace(X, "Du ", " ")
    X = Replace(X, " de ", " ")
    X = Replace(X, "De ", "")
    X = Replace(X, " des ", " ")
    X = Replace(X, "Des ", " ")
    X = Replace(X, " les ", " ")
    X = Replace(X, "Les ", " ")
    X = Replace(X, " le ", " ")
    X = Replace(X, "Le ", " ")
    X = Replace(X, " la ", " ")
    X = Replace(X, "La ", " ")
    X = Replace(X, " l'", " ")
    X = Replace(X, "L'", "")
    X = Replace(X, " d'", " ")
    X = Replace(X, "D'", "")
    X = Replace(X, "$", "")
    X = Replace(X, "@", "")
    X = Replace(X, "&", "")
    If Left(X, 1) <> " " Then X = " " & X
    X = Replace(X, "££", "£")
    X = Replace(X, " ", "£")

    For i = 1 To Len(X)
        If Mid(X, i, 1) = "£" Then A = A & Mid(X, i + 1, 1)
    Next
    Sigle = UCase(A)
End Function
Liste non exhaustive😉

Un peu plus....en PJ
Re...PJ remplacée
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Bonsour®
Jacky67 à dit:
Bonjour Modeste
Manque encore le "Ou" 😎
Merci de m'avoir rappeler la fonction "Trim()" que j'ai tendance à oublier.
Cliquez pour agrandir...
il conviendra toutefois de différencier la fonction VBA TRIM de la WorkSheetFunction.Trim qui ont des comportements différents.
VBA Trim : seule suppression des espaces précédents et suivants
WSF.Trim : suppression des espaces précédents et suivants + réduction à un seul des espaces redondants intérieurs

VB: 
Function Sigle(Y As Range) As String
    Dim X As String, A As String, i As Long
    X = Application.Proper(Y.Value)
  ' ---------------------------------- articles , conjonctions et sigles superfétatoires
    X = Replace(X, "$", " ")
    X = Replace(X, "@", " ")
    X = Replace(X, "&", " ")
    X = Replace(X, "(", " ")
    X = Replace(X, ")", " ")
    X = Replace(X, ".", " ")
    X = Replace(X, "-", " ")
    X = Replace(X, "D'", " ")
    X = Replace(X, "Du ", " ")
    X = Replace(X, "De ", " ")
    X = Replace(X, "Des ", " ")
    X = Replace(X, "Les ", " ")
    X = Replace(X, "Le ", " ")
    X = Replace(X, "La ", " ")
    X = Replace(X, "L'", " ")
    X = Replace(X, "Et ", " ")
    X = Replace(X, " Of ", " ")
    X = Replace(X, " Pour ", " ")
    X = Replace(X, " À ", " ")
    X = Replace(X, " Au ", " ")
    X = Replace(X, " Aux ", " ")
    X = Replace(X, " En ", " ")
    X = Replace(X, " Ou ", " ")
    X = Replace(X, " Un ", " ")
    X = Replace(X, " Une ", " ")
    X = Replace(X, " Par ", " ")
    ' ----------------------------suppression espaces redondants
    X = " " & WorksheetFunction.Trim(X)
    ' ----------------------------recupération initiales
    For i = 1 To Len(X)
        If Mid(X, i, 1) = " " Then A = A & Mid(X, i + 1, 1)
    Next
    Sigle = SansAccent(A)
End Function
Function SansAccent(texte)
'Définition des variables
     avec = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüÿÑñÇç_"
     sans = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuyNnCc "
     tmp = texte
'Boucle de traitement
     For i = 1 To Len(tmp)
         pot = InStr(avec, Mid(tmp, i, 1))
         If pot > 0 Then Mid(tmp, i, 1) = Mid(sans, pot, 1)
     Next i
     If tmp = 0 Then tmp = ""
     SansAccent = tmp
End Function
 
Vote positif 0 Vote négatif
Modeste geedee à dit:
Bonsour®
il conviendra toutefois de différencier la fonction VBA TRIM de la WorkSheetFunction.Trim qui ont des comportements différents.
VBA Trim : seule suppression des espaces précédents et suivants
WSF.Trim : suppression des espaces précédents et suivants + réduction à un seul des espaces redondants intérieurs

VB: 
Function Sigle(Y As Range) As String
    Dim X As String, A As String, i As Long
    X = Application.Proper(Y.Value)
  ' ---------------------------------- articles , conjonctions et sigles superfétatoires
    X = Replace(X, "$", " ")
    X = Replace(X, "@", " ")
    X = Replace(X, "&", " ")
    X = Replace(X, "(", " ")
    X = Replace(X, ")", " ")
    X = Replace(X, ".", " ")
    X = Replace(X, "-", " ")
    X = Replace(X, "D'", " ")
    X = Replace(X, "Du ", " ")
    X = Replace(X, "De ", " ")
    X = Replace(X, "Des ", " ")
    X = Replace(X, "Les ", " ")
    X = Replace(X, "Le ", " ")
    X = Replace(X, "La ", " ")
    X = Replace(X, "L'", " ")
    X = Replace(X, "Et ", " ")
    X = Replace(X, " Of ", " ")
    X = Replace(X, " Pour ", " ")
    X = Replace(X, " À ", " ")
    X = Replace(X, " Au ", " ")
    X = Replace(X, " Aux ", " ")
    X = Replace(X, " En ", " ")
    X = Replace(X, " Ou ", " ")
    X = Replace(X, " Un ", " ")
    X = Replace(X, " Une ", " ")
    X = Replace(X, " Par ", " ")
    ' ----------------------------suppression espaces redondants
    X = " " & WorksheetFunction.Trim(X)
    ' ----------------------------recupération initiales
    For i = 1 To Len(X)
        If Mid(X, i, 1) = " " Then A = A & Mid(X, i + 1, 1)
    Next
    Sigle = SansAccent(A)
End Function
Function SansAccent(texte)
'Définition des variables
     avec = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÌÍÎÏìíîïÙÚÛÜùúûüÿÑñÇç_"
     sans = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeIIIIiiiiUUUUuuuuyNnCc "
     tmp = texte
'Boucle de traitement
     For i = 1 To Len(tmp)
         pot = InStr(avec, Mid(tmp, i, 1))
         If pot > 0 Then Mid(tmp, i, 1) = Mid(sans, pot, 1)
     Next i
     If tmp = 0 Then tmp = ""
     SansAccent = tmp
End Function
Cliquez pour agrandir...
RE...
Pas mal tout y est...presque, reste les chiffres 😛
A quoi sert ,
If TMP = 0 Then TMP = ""
?
 
Vote positif 0 Vote négatif
Bonsoir à tous 🙂

Pourquoi ne pas utiliser un tableau Array , moins de remplacement à faire non? 😉



VB: 
Txt = Array("$", "@", "&", "/", "\", "(", ")", ".", "-", " D' ",  _
" Du ", " De ", " Des ", " L' ",  " Le ", " Les ", " La ", " Et ",  _
" Ou ", " Of ", " Pour ", " À ", " Au ", " Aux ", " En ",  "pour", "l'")
 
  For k = LBound(Txt) To UBound(Txt)
  X = Replace(X, Txt(k), " ")
  Next k
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

B
  • Question Question
XL 2016 Extraire un nombre d'une chaine de caractère
2
Réponses
18
Affichages
482
Eric 45
E
M
  • Résolu(e)
XL 2010 Ressortir uniquement les nombres de la musique d'une course hippique
Réponses
5
Affichages
246
mamarus1
M
A
  • Question Question
Microsoft 365 Extraire chaine qui se répète
Réponses
10
Affichages
364
danielco
D
P
  • Question Question
Microsoft 365 Extraire la totalité du contenu d'une cellule si une cellule commence par un nombre
2
Réponses
16
Affichages
748
PR.
P
M
  • Question Question
Microsoft 365 Extraire une chaine de caractère numérique d'une cellule
Réponses
10
Affichages
1 K
patricktoulon
patricktoulon
I
  • Résolu(e)
XL 2016 Obtenir une partie d'une chaine de caractères
Réponses
9
Affichages
498
iliess
I
G
  • Question Question
XL 2016 Extraire des données d'un pdf et les copier dans excel
2
Réponses
19
Affichages
2 K
kiki29
kiki29
F
  • Résolu(e)
extraire des doublons d'une chaine de caractères
2
Réponses
29
Affichages
2 K
patricktoulon
patricktoulon
oguruma
POWERQUERY :: Extraire des caractères selon un masque
Réponses
1
Affichages
721
oguruma
oguruma
A
  • Résolu(e)
XL 2016 Extraire une chaine de caractère entre deux caractères différents
Réponses
2
Affichages
1 K
Al1_44
A
T
  • Question Question
XL 2021 Extraire de mots d'une cellule
Réponses
10
Affichages
991
mapomme
mapomme
Lu76Fer
Corriger les problèmes d'utilisation de certains symboles ASCII
Réponses
10
Affichages
1 K
Lu76Fer
Lu76Fer
chaelie2015
  • Résolu(e)
Autres (RESOLU) Extraire des lettres âpres "KDL"
2
Réponses
15
Affichages
2 K
Staple1600
Staple1600
Chubby
  • Question Question
XL 2016 Extraire chaine de caractère
Réponses
7
Affichages
698
Chubby
Chubby
M
  • Question Question
XL 2016 Extraire plusieurs chaînes de caractères d'une même cellule
Réponses
14
Affichages
823
Mam's
M
Lu76Fer
  • Question Question
XL 2016 XLS - Comment déterminer les zones présentent au niveau d'une cellule ?
Réponses
2
Affichages
607
Lu76Fer
Lu76Fer
T
  • Question Question
XL 2016 isolés série de caractère d'une chaine
Réponses
3
Affichages
454
Staple1600
Staple1600
F
  • Question Question
Microsoft 365 Extraction d'un mot commençant par "XXX" d'une cellule dans Excel
Réponses
9
Affichages
1 K
freddylyon
F
D
  • Résolu(e)
Microsoft 365 Extraire caractères d'une chaine de caractères
Réponses
10
Affichages
967
fanch55
fanch55
chaelie2015
  • Résolu(e)
Autres (RESOLU)Restituer la première lettre de chaque mot dans une chaine(Formule)
Réponses
6
Affichages
2 K
job75
job75
Retour