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

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
Yurperqod

Yurperqod

XLDnaute Occasionnel
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
Jacky67

Jacky67

XLDnaute Barbatruc
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

  • kabamel sigle v2.xlsm
    18.6 KB · Affichages: 55
Dernière édition:
Vote positif 0 Vote négatif
Modeste geedee

Modeste geedee

XLDnaute Barbatruc
Bonsour®
Jacky67 à dit:
Bonjour Modeste
Manque encore le "Ou" :cool:
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
Jacky67

Jacky67

XLDnaute Barbatruc
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 :p
A quoi sert ,
If TMP = 0 Then TMP = ""
?
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
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

Discussions similaires

F
  • Résolu(e)
extraire des doublons d'une chaine de caractères
2
Réponses
29
Affichages
858
patricktoulon
patricktoulon
M
  • Question
Microsoft 365 Extraire une chaine de caractère numérique d'une cellule
Réponses
10
Affichages
375
patricktoulon
patricktoulon
Chubby
  • Question
XL 2016 Extraire chaine de caractère
Réponses
7
Affichages
443
Chubby
Chubby
P
  • Question
Microsoft 365 [RESOLU] - Sommer les chiffres d'une chaine de caractère sous condition
Réponses
6
Affichages
930
Pelote
P
N
  • Question
XL 2019 Extraire les premières lettres d'un prénom et nom dans des colonnes
Réponses
7
Affichages
4 K
nel27
N
D
  • Question
XL 2010 Extraire une chaine de caractère dans les mots d'une colonne dans excel
Réponses
3
Affichages
909
JHA
J
A
  • Résolu(e)
Microsoft 365 Extraire valeur d'une chaine de texte
Réponses
8
Affichages
1 K
JHA
J
F
  • Question
XL 2019 Power query - Est-il possible de récupérer la chaine de caractère d'une source
Réponses
3
Affichages
2 K
Flx1er
F
D
  • Résolu(e)
XL 2019 VBA : Calcul checksum xor d'une chaine de longueur variable
2
Réponses
22
Affichages
4 K
soan
S
C
  • Résolu(e)
XL 2016 EXTRAIRE LES CHIFFRES à PARTIR D'une chaîne de caractère
Réponses
9
Affichages
3 K
mapomme
mapomme

Membres actuellement en ligne

13 membres et 230 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 239
Messages
2 086 511
Membres
103 239
dernier inscrit
wari