Microsoft 365 Formules de haut vol

[Usine à gaz]

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

 

[Usine à gaz]

Bonjour Sylvanu
Désolé, je ne t'avais pas vu ta proposition et je t'en remercie

Elle fonctionne mais ... Je viens de m'apercevoir que dans le fichier à traiter il y a aussi des lignes ou tout est en majuscules et du coup, ça fonctionne plus !
Désolé de ne pas l'avoir vu avant
lionel

 

[Usine à gaz]

Re-Bjr Phil69970,

Désolé, je ne t'avais pas vu ton dernier #post

Je n'ai pas vu de modification lol
Mais ... Je viens de m'apercevoir que dans le fichier à traiter il y a aussi des lignes ou tout est en majuscules et du coup, ça fonctionne plus !
Désolé de ne pas l'avoir vu avant
lionel

 

[Phil69970]

Re

Et comment veux tu que l'on sache ou se trouve le nom de la ville exemple comment tu distingues :
NANCY le prénom de la ville de NANCY ?
Et plus généralement
MACHIN RENNES ELISABETH ou se se trouve la ville pour excel ?

*La macro de mon post te ressort tout ce qui est en majuscule sans faire de distinction ..... vu que c'est impossible.

@Phil69970

 

[Usine à gaz]

Peut-être en se servant des espaces ?

 

[job75]

Je viens de m'apercevoir que dans le fichier à traiter il y a aussi des lignes ou tout est en majuscules et du coup, les fonctions ne fonctionnent plus bien :

Evidemment, c'est rédhibitoire !!!

Pour revenir à mon post #25 je simplifie la 2ème fonction, fichier (2) :

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, 1)) Then s(i) = Chr(1): Exit For
Next j, i
'---suppression des doublons---
s = Split(Join(s), Chr(1))
Set d = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(s)
    x = Trim(s(i))
    If x <> "" Then If Not d.exists(x) Then d(x) = "": Mots_Majuscules = Mots_Majuscules & ", " & x
Next i
Mots_Majuscules = Mid(Mots_Majuscules, 3)
End Function

 

[Usine à gaz]

Re-Gérard,
Merci pour ce nouveau retour

e viens de m'apercevoir que dans le fichier à traiter il y a aussi des lignes ou tout est en majuscules et du coup, les fonctions ne fonctionnent plus bien :

"Evidemment, c'est rédhibitoire !!!"
Cela veut dire qu'il n'y a pas de solution quand tout est en majuscules ? ... sniff
lionel

 

[Usine à gaz]

Et en se servant des espaces puis en regroupant les communes avec un "-" dans une même colonne ?
Mais je ne sais pas le coder.

 

[Usine à gaz]

Peut-être avec données > convertir puis en regroupant les communes avec un "-" dans une même colonne ?

 

[job75]

Sur le fichier des posts #1 et #25 on constate que le dernier mot est toujours un prénom.

Pour le déplacer en 1ère position il suffit de compléter la 1ère fonction, fichier (3) :

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
'---dernier mot en 1ère position---
txt = Application.Trim(Join(s))
s = Split(txt)
If UBound(s) > -1 Then x = s(UBound(s)) Else x = ""
Mots_Minuscules = RTrim(x & " " & Left(txt, Len(txt) - Len(x)))
End Function

 

[Usine à gaz]

Encore merci Gérard,

ça fonctionne.
J'ai un dernier besoin :
pour un besoin de classement alphabétique, est-il possible d'avoir le nom en 1er et le prénom ensuite ?
Mais c'est déjà super comme ça,
Grand MERCI

 

[job75]

pour un besoin de classement alphabétique, est-il possible d'avoir le nom en 1er et le prénom ensuite ?

On peut placer le dernier mot en 2ème position, fichier (4) :

Function Mots_Minuscules(txt$)
Dim s, i%, x$, j%, ub%
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
'---dernier mot en 2ème position---
txt = Application.Trim(Join(s))
s = Split(txt)
ub = UBound(s)
If ub > 1 Then s(0) = s(0) & " " & s(ub): s(ub) = ""
Mots_Minuscules = RTrim(Join(s))
End Function

 

[Usine à gaz]

Encore Merci Gérard,

C'est mieux pour mon classement,
lionel

 

[job75]

Bon ce n'était pas fini Lionel.

Pour tester le fichier (4) j'ai copié la plage B2:E7 sur 60 000 lignes.

Chez moi l'opération s'effectue en 56 secondes, c'est beaucoup trop.

C'est dû au fait que le Dictionary de la 2ème fonction est recréé à chaque ligne.

Avec ce fichier (5) la 2ème fonction n'utilise plus le Dictionary :

Function Mots_Majuscules(txt$)
Dim s, i%, x$, j%, sep$
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 s(i) = Chr(1): Exit For
Next j, i
'---suppression des doublons---
s = Split(Join(s), Chr(1))
sep = ", " 'à adapter
For i = 0 To UBound(s)
    x = Trim(s(i))
    If x <> "" Then If InStr(Mots_Majuscules & sep, sep & x & sep) = 0 Then Mots_Majuscules = Mots_Majuscules & sep & x
Next i
Mots_Majuscules = Mid(Mots_Majuscules, Len(sep) + 1)
End Function

Le copier-coller sur 60 000 lignes s'effectue maintenant en 3,7 secondes.

 

[Usine à gaz]

Encore merci Gérard,

Pour l'instant, je n'ai pas vu de différence car je suis en test sur p'ti nbr de lignes

 

[Usine à gaz]

je viens de faire le test, c'est top = - de 7sec.