Microsoft 365 Formules de haut vol

Créer une discussion
Répondre

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
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,
Je vous souhaites un beau WE 🙂

Alertes à nos ténors lol

J'ai une base de données avec environ 50.000 Prospects.

Les informations sont dans le désordre et je voudrais les avoir dans un ordre défini.
Evidemment, cela me semble impossible.
J'ai fait un tas de tentatives sans succès.

Je soumets ce tour de magie à nos ténors.
Je joins un fichier test avec les résultats attendus.

Un grand merci pour votre aide,
Amicalement,
lionel 🙂
 

Pièces jointes

Solution
job75
Bonjour Lionel,

Tu sais bien qu'avec le VBA on peut presque tout faire 🙂

Ci joint le fichier qui utilise ces 2 fonctions VBA :
VB: 
Function Mots_Minuscules(txt$)
Dim s, i%, x$, j%
txt = Application.Trim(Replace(Replace(txt, "d'", ""), "l'", "") )'épuration
s = Split(txt)
For i = 0 To UBound(s)
    x = s(i)
    For j = 1 To Len(x)
        If Mid(x, j, 1) = LCase(Mid(x, j, 1)) Then GoTo 1
    Next j
    s(i) = ""
1 Next i
Mots_Minuscules = Application.Trim(Join(s))
End Function

Function Mots_Majuscules(txt$)
Dim s, i%, x$, j%, d As Object
txt = Application.Trim(Replace(Replace(txt, "d'", ""), "l'", "") )'épuration
s = Split(txt)
For i = 0 To UBound(s)
    x = s(i)
    For j = 1 To Len(x)
        If Mid(x, j, 1) = LCase(Mid(x, j...
Trier par date Trier par votes
Bonjour,

Pour la commune, utilisez ma fonction personnalisée Commune(x) :
VB: 
Function Commune(ByVal x As String) As String
Const separ = "'!""#$%&()*+,-./:;<=>?@[\]{|}¤"
Dim i&, j&
   For i = 1 To Len(separ): x = Replace(x, Mid(separ, i, 1), " "): Next
   x = Application.Trim(x) + " "
   For i = 1 To Len(x) - 2
      If Mid(x, i, 3) = UCase(Mid(x, i, 3)) Then Exit For
   Next i
   For j = i To Len(x)
      If Mid(x, j, 1) <> UCase(Mid(x, j, 1)) Then Exit For
   Next j
   Commune = Application.Trim(Mid(x, i, j - i - 1))
End Function
 
Vote positif 0 Vote négatif
Re,

Pour le prénom, manifestement, une fois on le place après le premier nom, une autre fois à la fin (après le 2ème nom) => donc pas trouvé de règle ni simple ni complexe.

A la rigueur une fonction approximative SansCommune (x), pas peaufinée du tout car à partir de don nées inorganisées, on ne peut qu'arriver à des erreurs tôt ou tard (plutôt tôt que tard d'ailleurs).

Je ne comprends pas comment une liste de propects peut-être autant "du n'importe quoi" 😵; ça doit être hors du cadre professionnel ?

Code: 
Function Commune(ByVal x As String) As String
Const separ = "'!""#$%&()*+,-./:;<=>?@[\]{|}¤"
Dim i&, j&
   For i = 1 To Len(separ): x = Replace(x, Mid(separ, i, 1), " "): Next
   x = Application.Trim(x) + " "
   For i = 1 To Len(x) - 2
      If Mid(x, i, 3) = UCase(Mid(x, i, 3)) Then Exit For
   Next i
   For j = i To Len(x)
      If Mid(x, j, 1) <> UCase(Mid(x, j, 1)) Then Exit For
   Next j
   Commune = Application.Trim(Mid(x, i, j - i - 1))
End Function

Function SansCommune(ByVal x As String) As String
Const separ = "'!""#$%&()*+,-./:;<=>?@[\]{|}¤"
Dim i&
   For i = 1 To Len(separ): x = Replace(x, Mid(separ, i, 1), " "): Next
   x = Application.Trim(x) + " "
   x = Application.Trim(Replace(x, Commune(x), " "))
End Function
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Bonjour @mapomme

Je crois qu'il y a un pb sur ta fonction


1645264816362.png

J'ai essayé aussi avec ton post #4

C'est vrai que les données laissent à désirer....😉
C'est aussi vrai qu'il ne veut que les noms de villes donc par rapport à cela ta formule fonctionne.😉

@Phil69970
 
Vote positif 0 Vote négatif
Bonjour Lionel, Phil, MaPomme,
Un autre essai avec :
VB: 
Sub Extrait()
    Dim DL, T, T2(), M, i, j, Flag, Chaine1$, Chaine2$, IndexT2, Nb%
    Application.ScreenUpdating = False
    DL = Range("B65500").End(xlUp).Row
    T = Range("B2:B" & DL)
    ReDim T2(UBound(T), 2): IndexT2 = 1
    ' Suppression des l' et des d'
    For i = 1 To DL
        On Error Resume Next
        T(i, 1) = Application.Replace(T(i, 1), "l'", "")
        T(i, 1) = Replace(T(i, 1), "d'", "")
    Next i
    ' Séparation des mots en majuscules
    For i = 1 To DL
        Chaine1 = "": Chaine2 = ""
        M = Split(T(i, 1), " ")
        For j = 0 To UBound(M)
            If M(j) = UCase(M(j)) Then
                Chaine1 = Chaine1 & " " & M(j)
            Else
                Chaine2 = Chaine2 & " " & M(j)
            End If
        Next j
        T2(IndexT2, 1) = Chaine2: T2(IndexT2, 2) = Chaine1
        IndexT2 = IndexT2 + 1
    Next i
    ' Suppression mots doublons
    For i = 1 To UBound(T2)
        T2(i, 2) = SupDoublons(T2(i, 2), " ")
    Next i
    ' Rangement matrice résultats
    Range("$D$2").Resize(UBound(T2, 1), UBound(T2, 2)) = T2
End Sub
Function SupDoublons(txt, Optional delim As String = " ") As String
'https://fr.extendoffice.com/documents/excel/2133-excel-remove-duplicate-characters-in-string.html
    Dim x
    'Updateby Extendoffice
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For Each x In Split(txt, delim)
            If Trim(x) <> "" And Not .exists(Trim(x)) Then .Add Trim(x), Nothing
        Next
        If .Count > 0 Then SupDoublons = Join(.keys, delim)
    End With
End Function
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour @sylvanu 🙂

A mon avis, tu auras beau faire, je ne vois aucun moyen de bien placer le prénom final...
(Bidule CHERBOURG et Carine Bidulette CHERBOURG Christophe place mal le prénom Christophe)

Dans un sens, c'est rassurant, notre cerveau est capable en une fraction de seconde de le faire et sans se fatiguer ni faire chauffer dangereusement ses cellules 😜 Il doit exister des circuits conçus ou entrainés (ou éduqués) pour cela.
 
Dernière édition:
Vote positif 0 Vote négatif
Bonsoir le fil

[aparté du dimanche matin]
Je ne comprends pas comment une liste de propects peut-être autant "du n'importe quoi" 😵; ça doit être hors du cadre professionnel ?
Cliquez pour agrandir...
Il ne peut en être autrement 😉
Une usine à gaz est forcément agencée en dépit du bon sens.
D'un autre côté, puisque c'est Excel qu'on utilise pour "mettre le dawa", je m'en retourne à samedi, tout en en pensant que si j'étais moi, j'irai voir, non pas du côté de chez Swan, mais au fond du couloir où j'ai rangé mes patterns RegExp
[/aparté]

NB: On prendra soin de noter qu'il ne s'agit que d'un trait d'humour.
Pas d'une attaque, d'une critique envers tel ou tel.
Bah, oui, en ces temps où le wokisme s'insinue partout, je ne voudrais pas que le Syndicat de Défense des Usines à Gaz non OGM, élevées en plein air me tombe dessus 😉

EDITION: Désolé, patricktoulon a été plus rapide que moi pour sortir son trait d'humour.
 
Vote positif 0 Vote négatif
Staple1600 à dit:
Bonsoir le fil

[aparté du dimanche matin]

Il ne peut en être autrement 😉
Une usine à gaz est forcément agencée en dépit du bon sens.
D'un autre côté, puisque c'est Excel qu'on utilise pour "mettre le dawa", je m'en retourne à samedi, tout en en pensant que si j'étais moi, j'irai voir, non pas du côté de chez Swan, mais au fond du couloir où j'ai rangé mes patterns RegExp
[/aparté]

NB: On prendra soin de noter qu'il ne s'agit que d'un trait d'humour.
Pas d'une attaque, d'une critique envers tel ou tel.
Bah, oui, en ces temps où le wokisme s'insinue partout, je ne voudrais pas que le Syndicat de Défense des Usines à Gaz non OGM, élevées en plein air me tombe dessus 😉

EDITION: Désolé, patricktoulon a été plus rapide que moi pour sortir son trait d'humour.
Cliquez pour agrandir...
Tien, tien, mon Staple1600 préféré car le seul que je connais lol

Que nenni : le fichier en question ne provient pas de mes usines à gaz.
Content de te "revoir",
lionel 😇🇹🇳
 
Dernière édition:
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

Usine à gaz
  • Résolu(e)
Microsoft 365 Boucle ?
Réponses
13
Affichages
825
Usine à gaz
Usine à gaz
Usine à gaz
  • Résolu(e)
Microsoft 365 Bulle : affichage à droite de la cellule cliquée
2 3
Réponses
30
Affichages
2 K
Usine à gaz
Usine à gaz
Usine à gaz
  • Question Question
Microsoft 365 exécuter un code uniquement si le classeur est ouvert sur mon ordinateur
2 3
Réponses
32
Affichages
2 K
Tetonne
T
Usine à gaz
  • Résolu(e)
Microsoft 365 InputBox est-il possible de masquer la barre de titre ?
2 3 4
Réponses
48
Affichages
4 K
soan
S
Usine à gaz
  • Résolu(e)
Microsoft 365 sms Factor adaptation API vers Excel office365
Réponses
4
Affichages
1 K
Usine à gaz
Usine à gaz
Usine à gaz
  • Résolu(e)
Microsoft 365 formules pour remplacer les caractères "st" et "ste" en début de chaine de texte ou dans la chaine si séparés par 1 espace avant et 1 espace après
2 3 4
Réponses
50
Affichages
4 K
Usine à gaz
Usine à gaz
Usine à gaz
  • Résolu(e)
Microsoft 365 Import informations de fichiers fermés
2
Réponses
29
Affichages
3 K
Usine à gaz
Usine à gaz
Usine à gaz
  • Résolu(e)
Microsoft 365 effacer à partir de la cellule sélectionnée (ou ligne )
Réponses
9
Affichages
978
Usine à gaz
Usine à gaz
Usine à gaz
  • Question Question
XL 2016 NB.SI.ENS : nbr appels par client +nbr RdVs avec condition date
2 3
Réponses
33
Affichages
3 K
Usine à gaz
Usine à gaz
Retour