Passer en minuscule sauf 1ère lettre du premier mot

Bonjour tout le monde,

Je sais que le sujet est beaucoup évoqué, j'ai trouvé pas mal de forum et j'avais réussis à trouver ma réponse mais en version formule ce qui ne me convient pas spécialement car en fait je dois aussi faire plusieurs autres changements (remplacer des mots sans accents avec des mots avec accents).

Voir le fichier joint, sur la feuil1 colonne A il y a le mot à changer colonne B il y a normalement le mot changé

Sur la feuil2 il y a un tableau reprenant ce qui doit être modifié, problème je remarque qu'il n'y a pas de prise en compte de la MAJ donc si par exemple dans mon mot à changer j'ai chene avec le tableau de la feuil2 il devrait passer à chêne sauf qu'il passe à Chêne.

Je ne sais pas comment faire pour éviter cela, j'aimerais en soit que si j'ai :

- CHENE LAMEL il se transforme en Chêne Lamel

- COLLECTION MAISON CHENE il se transforme en Collection maison chêne

Merci d'avance à vous,

Cordialement,

PS : sur le fichier je n'ai que le changement de mot car c'est la seule formule que j'ai réussis à trouver et donc je cherchais pour ajouter à ça ma transformation de MAJ en Min (donc mes derniers exemples sont vraiment ce que j'ai sur mon fichier de base : CHENE LAMEL par exemple)

Bonjour,

Essayez ceci, j'ai considéré qu'il n'y a avait qu'un mot par cellule à contrôler.

Le code

Sub Conserver_Texte()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f2 As Long
    Dim i As Long, j As Long
    Dim x As Range
    Dim Texte As Variant, Texte2 As String, Chaine As String
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To DerLig_f1
        Chaine = " " & f1.Cells(i, "A")
        Texte = Split(Chaine, " ")
        For j = 1 To UBound(Texte)
            PositionTexte = InStr(1, f1.Cells(i, "A"), Texte(j), 1)
            Set x = f2.Range("A1:A" & DerLig_f2).Find(Texte(j), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            If Not x Is Nothing Then
                Texte2 = f2.Range("B" & x.Row)
                f1.Cells(i, "B") = Replace(f1.Cells(i, "A"), Texte(j), Texte2, 1)
                Exit For
            End If
        Next
    Next i
    Set x = Nothing
    Set f1 = Nothing
    Set f2 = Nothing
End Sub
   

le fichier

Cdlt

Bonjour, j'avoue ne pas trop bien comprendre l'exemple Passer en minuscule sauf la première lettre ok çà je comprends ..

mais les accents qui reviennent s'installer tout seul là je vois pas.

Bonjour à vous,

Merci pour ces premières réponses,

@Arturo83 je vais essayer le code au plus vite, en effet je n'ai pas qu'un mot à changer mais j'imagines qu'il suffit de rajouter des lignes dans le code de la façon dont vous avez procédé ?

@Xmenpl Le fichier est en fait un retour fournisseur mais la donnée est toujours envoyée en Majuscule sans accent (déjà car certains fournisseurs sont étrangers donc assez compliqué de demander l'accent et ça évite les erreurs), ensuite ce fichier est intégré dans notre SI et les noms seront reprit pour apparaître sur internet, il faut donc avoir un "beau" nom.

Je sais pas si je suis plus clair dans mes propos n'hésitez pas à me le dire :)

Ok je vois un peu mieux Mais c'était pas plus simple de faire un onglet avec une table de correspondance client Majuscule ---> Nom retenu

Ainsi une simple recherche dans l'onglet table ramènerait le nom correctement orthographié même avec des caractères étrangers au besoin pour les minuscules.

Xmenpl le problème c'est que je n'ai pas les noms au préalable donc je ne peux pas déjà prévoir une table de correspondance, et si je le faisais à la main ça prendrait très/trop longtemps :/

Arturo83, ah ! quand tu parles d'un mot tu veux dire un mot dans la même case ou alors 1 mot pour toute la colonne ? Car si c'est dans la case il y a 99% de chance que ce soit bien un seul (mais du coup je préfère quand même éviter le risque haha), si c'est dans la colonne il y aura forcément plus d'un mot oui :/

Bonjour Arturo83,

Je suis désolé pour le délais de réponse, quelques petits soucis ...

Après vérification j'ai bien des cases où il y aura plusieurs mots à vérifier/changer, comment faut-il procéder dans ce cas là ?

Merci d'avance à toi et bonne journée,

Cordialement,

Bonjour

Travailler sur un exemple non représentatif est un non sens

Mettre une majuscule au début d'un chaîne convertie en minuscule est hyper simple que ce soit pas formule, VBA ou PowerQuery

En revanche sauf lexique, il n'est pas possible de mettre automatiquement des accents... idem pour mettre aussi une majuscule à certains mots autres que le premier et pas à tous...

Bonjour,

Vous avez écrit:

"Xmenpl le problème c'est que je n'ai pas les noms au préalable donc je ne peux pas déjà prévoir une table de correspondance, et si je le faisais à la main ça prendrait très/trop longtemps :/"

Pourtant, il faudra bien qu'il y ait une table de correspondance, sinon comment fait-on pour savoir quel mot remplacer par un autre, sous quelles formes, majuscules minuscules, avec accents, sans d'accents?

Ni EXCEL ni le VBA ne peuvent deviner quel sont les termes à remplacer s'ils ne disposent pas d'une liste de noms avec leurs équivalences?

Pour la table de correspondance, ne pouvez-vous pas ajoutez des nouveaux noms au fur et à mesure que vous en rencontrez?

Cdlt

Bonjour à vous deux,

@Arturo83, j'ai mal comprit le message de Xmenpl, pour moi tableau de correspondance voulait dire que je savais au préalable ce que le fournisseur allait mettre dans la case, par exemple que le fournisseur aller mettre : "APPALAGIO CHENE" sauf que le "APPALAGIO" je ne peux pas le deviner mais le CHENE oui.

Alors effectivement il sera possible qu'au fur et à mesure j'ajouterais de nouveaux termes dans le tableau si c'est ça.

@chris78, je ne comprends pas trop ton message, que veux-tu dire par exemple non représentatif ? En gros je veux d'abord le changement de mot puis ensuite je passe en minuscule sauf la première lettre du premier mot.

Je joins un fichier qui pourra peut être vous permettre de voir ce que je reçois versus l'attendu avec un feuil2 le "tableau de correspondance" si j'ai bien comprit le terme.

Merci d'avance à vous,

Cordialement,

RE

kinders59 a écrit :

@chris78, je ne comprends pas trop ton message, que veux-tu dire par exemple non représentatif ?
En gros je veux d'abord le changement de mot puis ensuite je passe en minuscule sauf la première lettre du premier mot.

J'imagine que le fichier réel contient un titre de colonne qui n'est pas celui indiqué pour qu'on comprenne, a peut-être plusieurs colonne.

Si on code en VBA ou une requête PowerQuery, il faut que ton exemple représente bien le fichier reçu

kinders59 a écrit :

- CHENE LAMEL il se transforme en Chêne Lamel

- COLLECTION MAISON CHENE il se transforme en Collection maison chêne

Donc un traitement différent selon les lignes puisque dans un cas tu mets un majuscule au 2ème mot et pas dans l'autre...

C'est comme pour les accents, pas possible sans lexique

Bonjour,

La modif demandée:

Sub Conserver_Texte()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f2 As Long
    Dim i As Long, j As Long
    Dim x As Range
    Dim Texte As Variant, Texte2 As String, Chaine As String
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To DerLig_f1
        Chaine = " " & f1.Cells(i, "A")
        Texte = Split(Chaine, " ")
        For j = 1 To UBound(Texte)
            PositionTexte = InStr(1, f1.Cells(i, "A"), Texte(j), 1)
            Set x = f2.Range("A1:A" & DerLig_f2).Find(Texte(j), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            If Not x Is Nothing Then
                Texte2 = f2.Range("B" & x.Row)
                Chaine = Replace(Chaine, Texte(j), Texte2, 1)
            End If
        Next
        f1.Cells(i, "B") = UCase(Left(Trim(LCase(Chaine)), 1)) & Right(Trim(LCase(Chaine)), Len(Trim(LCase(Chaine))) - 1)
    Next i
    Set x = Nothing
    Set f1 = Nothing
    Set f2 = Nothing
End Sub
   

Cdlt

@78chris, désolé c'est moi qui est fait une erreur, c'est bien qu'une lettre majuscule sur le 1er mot

- CHENE LAMEL il se transforme en Chêne Lamel : Chêne lamellé

Effectivement il y a bien un titre de colonne, mais est-il vraiment important dans la rédaction du VBA ? (PowerQuery pour le coup je ne connais absolument rien j'ai pas spécialement envie de m'y aventurer pour le moment, je préfère comprendre quand même un peu ce qu'il en est au cas où je dois revoir ensuite le code etc)

Pour le lexique, c'est ce que je fais apparaître sur la feuil2 dans l'exemple mais demain ça sera un autre onglet avec un nom (qui sera caché évidemment) mais si je comprends déjà le code je pense que je pourrais l'adapter ensuite vraiment à mon fichier de base.

Ce n'est pas que je ne veux pas envoyer mon fichier, c'est juste que j'ai déjà beaucoup de données (et surtout des "privés") et j'ai peur d'oublier d'en supprimer certaines avant d'envoyer le fichier :/

@Arturo83, merci de ta réponse je vais regarder et analyser ça :)

@Arturo83, ton code fonctionne au top ! Merci beaucoup, serait-il possible d'avoir tout de même un peu de compréhension sur celui-ci je comprends certaines formules mais sur d'autres je suis dans un flou total (et c'est à mon avis la majeur partie de ton code )

Chaine = " " & f1.Cells(i, "A")
        Texte = Split(Chaine, " ")
        For j = 1 To UBound(Texte)
            PositionTexte = InStr(1, f1.Cells(i, "A"), Texte(j), 1)
            Set x = f2.Range("A1:A" & DerLig_f2).Find(Texte(j), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            If Not x Is Nothing Then
                Texte2 = f2.Range("B" & x.Row)
                Chaine = Replace(Chaine, Texte(j), Texte2, 1)
            End If
        Next

Pourrais-tu si cela ne te dérange pas m'expliquer un peu comment ça fonctionne ligne par ligne ?

Merci d'avance à toi et bonne journée !

Cordialement,

Voilà pour l'essentiel:

For i = 2 To DerLig_f1 ' de la ligne 2 jusqu'à la dernière
Chaine = " " & f1.Cells(i, "A") 'on ajoute un espace devant la chaÎne de mots
Texte = Split(Chaine, " ") 'on isole chaque mot séparé par un espace
For j = 1 To UBound(Texte) 'on fait une bouche sur tous les mots de la même chaine
PositionTexte = InStr(1, f1.Cells(i, "A"), Texte(j), 1) 'on repère la position de chaque mot isolé
Set x = f2.Range("A1:A" & DerLig_f2).Find(Texte(j), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) 'on recherche le mot dans la colonne A de la table de correspondance
If Not x Is Nothing Then ' s'il existe
Texte2 = f2.Range("B" & x.Row) 'alors on récupère le mot de la colonne B
Chaine = Replace(Chaine, Texte(j), Texte2, 1) 'on remplace le mot ancien par le nouveau dans la chaîne
End If
Next ' on passe au mot suivant, toujours dans la même chaîne
'Pour la ligne suivante, voir l'explication ci-dessous
f1.Cells(i, "B") = UCase(Left(Trim(LCase(Chaine)), 1)) & Right(Trim(LCase(Chaine)), Len(Trim(LCase(Chaine))) - 1)
Next i

'Pour la ligne suivante:
'f1.Cells(i, "B") = UCase(Left(Trim(LCase(Chaine)), 1)) & Right(Trim(LCase(Chaine)), Len(Trim(LCase(Chaine))) - 1)
'1) - on convertit la chaîne entière en minuscules avec "LCase(Chaine)"
'2) - on supprime les espaces de part et d'autre de la chaîne avec "Trim"
'3) - on conevrtit la première lettre de la chaîne en majuscule avec "UCase(Left(Trim(LCase(Chaine)), 1))"
'4) - on reconstitue la chaîne entière en agglomérant toute ces fonctions que l'on colle dans la colonne B

Cdlt

@Arturo83, Merci beaucoup pour les informations

Hello @Arturo83 et les autres,

Je reviens tard sur le sujet car je me pose une question, penses-tu qu'il serait possible que le changement s'applique directement dans la colonne où il y a le mot à changer au lieu de le faire dans une colonne à côté ? J'ai essayé de mon côté mais je fais planter le code si je fais ça, ce qui me semble normal au vue du fait qu'il boucle.

Du coup je me demandais si on pouvait quand même le faire directement dans la même colonne ou alors faire comme maintenant puis faire un remplacement de colonne ? Ce qui du coup ferait que la macro serait plus longue et ce qui ne doit pas être le mieux à faire j'imagine ?

Merci d'avance à toi ou à tout autre personne qui aurait la réponse

Bonne journée,

Cordialement

Bonjour,

Oui, il suffit d'ajouter une ligne en fin de code et de supprimer la colonne B

    f1.Range("B2:B" & DerLig_f1).Copy f1.Range("A2")

Le code au complet:

Sub Conserver_Texte()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f2 As Long
    Dim i As Long, j As Long
    Dim x As Range
    Dim Texte As Variant, Texte2 As String, Chaine As String
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To DerLig_f1 ' de la ligne 2 jusqu'à la dernière
        Chaine = " " & f1.Cells(i, "A") 'on ajoute un espace devant la chaÎne de mots
        Texte = Split(Chaine, " ") 'on isole chaque mot séparé par un espace
        For j = 1 To UBound(Texte) 'on fait une bouche sur tous les mots de la même chaine
            PositionTexte = InStr(1, f1.Cells(i, "A"), Texte(j), 1) 'on repère la position de chaque mot isolé
            Set x = f2.Range("A1:A" & DerLig_f2).Find(Texte(j), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) 'on recherche le mot dans la colonne A de la table de correspondance
            If Not x Is Nothing Then ' s'il existe
                Texte2 = f2.Range("B" & x.Row) 'alors on récupère le mot de la colonne B
                Chaine = Replace(Chaine, Texte(j), Texte2, 1) 'on remplace le mot ancien par le nouveau dans la chaîne
            End If
        Next ' on passe au mot suivant, toujours dans la même chaîne
        'Pour la ligne suivante, voir l'explication ci-dessous
        f1.Cells(i, "B") = UCase(Left(Trim(LCase(Chaine)), 1)) & Right(Trim(LCase(Chaine)), Len(Trim(LCase(Chaine))) - 1)
    Next i

    f1.Range("B2:B" & DerLig_f1).Copy f1.Range("A2")
    Columns(2).ClearContents
    Set x = Nothing
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

   'Pour la ligne suivante
        'f1.Cells(i, "B") = UCase(Left(Trim(LCase(Chaine)), 1)) & Right(Trim(LCase(Chaine)), Len(Trim(LCase(Chaine))) - 1)
'1) - on convertit la chaîne entière en minuscules avec "LCase(Chaine)"
'2) - on supprime les espaces de part et d'autre de la chaîne avec "Trim"
'3) - on convertit la première lettre de la chaîne en majuscule avec "UCase(Left(Trim(LCase(Chaine)), 1))"
'4) - on reconstitue la chaîne entière en agglomérant toute ces fonctions que l'on colle dans la colonne B

Cdlt