Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Formules de haut vol

Créer une discussion

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

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
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 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 🙂
 
Vote positif 0 Vote négatif
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 🙂
 
Dernière édition:
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
Usine à gaz à dit:
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 :
Cliquez pour agrandir...
Evidemment, c'est rédhibitoire !!!

Pour revenir à mon post #25 je simplifie la 2ème fonction, fichier (2) :
VB: 
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
 

Pièces jointes

Vote positif 0 Vote négatif
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) :
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
'---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
 

Pièces jointes

Vote positif 0 Vote négatif
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 🙂
 
Vote positif 0 Vote négatif
Usine à gaz à dit:
pour un besoin de classement alphabétique, est-il possible d'avoir le nom en 1er et le prénom ensuite ?
Cliquez pour agrandir...
On peut placer le dernier mot en 2ème position, fichier (4) :
VB: 
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
 

Pièces jointes

Vote positif 0 Vote négatif
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 :
VB: 
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.
 

Pièces jointes

Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
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

  • Résolu(e)
Microsoft 365 Boucle ?
Réponses
13
Affichages
825
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
  • 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
  • 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
  • Résolu(e)
Microsoft 365 sms Factor adaptation API vers Excel office365
Réponses
4
Affichages
1 K
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
  • Résolu(e)
Microsoft 365 Import informations de fichiers fermés
2
Réponses
29
Affichages
3 K
Usine à gaz
  • Résolu(e)
Microsoft 365 effacer à partir de la cellule sélectionnée (ou ligne )
Réponses
9
Affichages
978
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
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…