[Résolu] Renommer automatiquement une liste de données en fonction d'une autre VBA

arthur203

XLDnaute Junior
Bonjour à tous,

Un petit problème bien embêtant:
J'ai une liste de données contenu dans la feuil1:
1.1 riri
1.2 lulu et toto
...
13.11 lolo et lala

dans d'autres feuilles du même classeurs il y a cette même liste mais l'orthographe n'est pas exactement la même:
1.1 riri(+ un petit espace qui fait planter ma macro)
1.2 lululala
....
13.11 LoLo et la

Par contre le début est le même (1.1 - 1.2 - .... - 13.11). Je pensais à faire un truc du genre si gauche 3 premiers termes = 1.1 alors "lulu et toto" mais vu que ma liste contient plus de 50 référentiels je me demandais s'il n'y avait pas une macro qui pourrait bien faire ça.

Merci !
 
Dernière édition:

Robert

XLDnaute Barbatruc
Repose en paix
Re : Renommer automatiquement une liste de données en fonction d'une autre VBA

Bonjour Arthur, bonjour le forum,

Et le fichier en pièce jointe ? On veut bien te faire la macro mais il nous faudrait les éléments ! Allez un petit effort...
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Renommer automatiquement une liste de données en fonction d'une autre VBA

Bonsoir Arthur, bonsoir le forum,

Le code ci-dessous supprime tous les espaces avant et/ou après de toutes les cellules éditées de tous les onglets. Peut-être est-ce suffisant pour toi :
Code:
Sub Macro1()
Dim O As Object 'déclare la variable o (Onglet)
Dim cel As Range 'déclare la variable cel (CELlule)

For Each O In Sheets 'boucle 1 : sur tous les onglets du classeur
    For Each cel In O.UsedRange 'boucle 2 : sur toutes les cellule de la plage des cellules éditées
        cel.Value = "'" & Trim(cel.Value) 'remplace la valeur de la cellule par la valeur de la cellule sans espaces avant ou après en texte
    Next cel 'prochaine cellule de la boucle 2
Next O 'prochain onglet de la boucle 1
End Sub
 

arthur203

XLDnaute Junior
Re : Renommer automatiquement une liste de données en fonction d'une autre VBA

Merci pour cette macro c'est bien utile mais malheureusement pas suffisant, parfois il y a une lettre en trop ou en moins. Mise à part la fonction gauche qui va prendre un temps considérable n'y aurait il pas un autre moyen ?
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Renommer automatiquement une liste de données en fonction d'une autre VBA

Bonsoir Arthur bonsoir le forum,

Oui tu as raison Arthur, la macro navet (dans ce cas on peut...) rien à voir ! Voici un nouveau code. Je l'ai testé et je pense qu'il devrait convenir :
Code:
Sub Macro1()
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim r1 As Range 'déclare la variable r1 (Recherche 1)
Dim pa1 As String 'déclare la variable pa1 (Première Adresse 1)
Dim r2 As Range 'déclare la variable r2 (Recherche 2)
Dim pa2 As String 'déclare la variable pa2 (Première Adresse 2)

With Sheets("Feuil1") 'prend en compte l'onglet "Feuil1"
    dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne dl de la colonne A
    Set pl = .Range("A2:A" & dl) 'définit la plage pl
End With 'fin de la prise en compte de l'onglet "Feuil1"
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    'définit la recherche 1 (recherche dans la colonne B de l'onglet "Feuil2" le texte de la cellule cel avant l'espace)
    Set r1 = Sheets("Feuil2").Columns(2).Find(Split(cel.Value, " ")(0), , xlValues, xlPart)
    If Not r1 Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
        pa1 = r1.Address 'définie l'adresse pa1 de la première occurrence trouvée pour la recherche 1
        Do 'exécute
            'si le texte avant l'espace de la cellule cel est le même que le texte
            'avant l'espace de l'occurrence trouvée r1, r1 prend la valeur de cel
            If Split(cel, " ")(0) = Split(r1, " ")(0) Then r1.Value = cel.Value
            Set r1 = Sheets("Feuil2").Columns(2).FindNext(r1) 'redéfinit la recherche r1 (occurrence suivante)
        Loop While Not r1 Is Nothing And r1.Address <> pa1 'boucle tant qu'il existe des occurrences ailleurs qu'en pa1
    End If 'fin de la condition
   'définit la recherche 2 (recherche dans la colonne C de l'onglet "Feuil3" le texte de la cellule cel avant l'espace)
    Set r2 = Sheets("Feuil3").Columns(3).Find(Split(cel.Value, " ")(0), , xlValues, xlPart)
    If Not r2 Is Nothing Then 'condition : si il exite au moins une occurrence trouvée
        pa2 = r2.Address 'définit l'adresse pa2 de la première occurrence trouvée pour la recherche 2
        Do 'exécute
            'si le texte avant l'espace de la cellule cel est le même que le texte
            'avant l'espace de l'occurrence trouvée r2, r2 prend la valeur de cel
            If Split(cel, " ")(0) = Split(r2, " ")(0) Then r2.Value = cel.Value
            Set r2 = Sheets("Feuil3").Columns(3).FindNext(r2) 'redéfinit la recherche r2 (occurrence suivante)
        Loop While Not r2 Is Nothing And r2.Address <> pa2 'boucle tant qu'il existe des occurrences ailleurs qu'en pa2
    End If 'fin de la condition
Next cel 'prochaine cellule cel de la boucle
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 147
Messages
2 085 768
Membres
102 969
dernier inscrit
pizza