Souci avec une macro

Résolu
Boucle -  
Bonjour à tous,

Je suis actuellement en pleine bataille avec une macro et cette dernière me résiste.
Je vous explique mon souci.

J'ai un fichier excel de deux pages, chaque page contient environ 4500 lignes.
On y trouve deux colonnes (un numéro dans la première et un commentaire dans la seconde)

Je souhaite prendre la cellule (2:1) de ma 2ème page (donc un numéro), passer sur la première page et recherche ce numéro dans mes lignes, une fois la ligne trouvée remplacer le commentaire de la 1ère page par le commentaire de la seconde page (le commentaire associé au numéro) et je voudrais surtout pouvoir faire le même mouvement pour mes 4500 lignes.

J'ai pensé utiliser une fonction WHILE / WEND mais j'avoue ne pas comprendre comment lancer la recherche et relancer le programme automatiquement jusqu'à avoir analyser mes 4500 lignes.

Merci par avance aux personnes qui prendront le temps de me répondre!

ps: je précise avoir lu plusieurs topic et tuto avant de poster car je n'arrive pas pour autant à comprendre la démarche

4 réponses

  2. michel_m Contributeur
    Bonjour

    Il y a t il des doublons dans la première feuille ?

    Au besoin:
    mettre le classeur sans données confidentielles en pièce jointe sur
    https://www.cjoint.com/
    puis copier l'adresse du lien et la coller dans le message de réponse

    0
    1. Boucle
      Non, je n'ai pas de doublon dans ma 1ere feuille.
      0
      1. michel_m Contributeur
        mettre le classeur sans données confidentielles en pièce jointe sur
        https://www.cjoint.com/
        puis copier l'adresse du lien et la coller dans le message de réponse
        0
      2. Boucle
        Voici un fichier exemple: http://cjoint.com/data3/3FhnJYDcKJN.htm
        0
    2. michel_m Contributeur
      proposition de macro rapide (4500 lignes) 

      Option Explicit

Sub actualiser_commentaire()
Dim Derlig As Integer, T_new(), T_old()
Dim D_new As Object
Dim Cptr As Integer, Ref As String * 9, Obs As String
Dim start As Single      ' supprimer àprès essais
start = Timer                 'supprimer àprès essais

'mémorisation des tableaux Excel en Ram
With Sheets(1)
     Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     T_new = .Range("A1:C" & Derlig).Value
End With
With Sheets(2)
     Derlig = .Columns("C").Find("*", , , , , xlPrevious).Row
     T_old = .Range("C2:G" & Derlig).Value
End With
'création des couple Reférences -observation du tableau virtuel de la page 1
Set D_new = CreateObject("scripting.dictionary")
For Cptr = 1 To UBound(T_new)
     Ref = T_new(Cptr, 1)
     Obs = T_new(Cptr, 3)
     If Not D_new.exists(T_new(Cptr, 1)) Then D_new.Add Ref, Obs
Next

'parcoure le tableau virtuel de la page 2 Si la ref existe dans le dictionnaire _
on remplace l'ancienne observation par la nouvelle
For Cptr = 1 To UBound(T_old)
     If D_new.exists(T_old(Cptr, 1)) Then T_old(Cptr, 5) = D_new.Item(T_old(Cptr, 1))
 Next
 
 'restitution des nouvelles obsevations en feuille 2
 With Sheets(2)
     .Range("C2:G" & Cptr) = T_old
     .Select
     MsgBox "Actualisation effectuée en: " & Timer - start & " sec." 'supprimer àprès essais
 
 End With
End Sub


      Ton classeur avec la macro
      https://www.cjoint.com/?3FhpaJOQ2WY
      Michel
      0
      1. Boucle
        Merci beaucoup Michel_m c'est exactement ce que je voulais!

        Encore merci pour avoir pris de ton temps pour m'aider.
        0
      2. michel_m Contributeur
        Content pour toi!

        Effectivement les 2 demandes étaient différentes: au temps pour moi !!

        A+ et bon WE ensoleillé (espèrons!)
        0
      3. Boucle
        J'ai néanmoins un (petit) souci , je souhaite que ca soit la page 2 qui actualise la page 1 (c'est le contraire actuellement).
        0
      4. michel_m Contributeur
        Bonjour,

        Effectivement, je m'étais croisé les yeux, excuses moi....

        macro corrigée 
        Option Explicit

Sub actualiser_commentaire()
Dim Derlig As Integer, T_new(), T_old()
Dim D_new As Object
Dim Cptr As Integer, Ref As String * 9, Obs As String

'mémorisation des tableaux Excel en Ram
With Sheets(1)
     Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
     T_old = .Range("A1:C" & Derlig).Value
End With
With Sheets(2)
     Derlig = .Columns("C").Find("*", , , , , xlPrevious).Row
     T_new = .Range("C2:G" & Derlig).Value
End With
'création des couple Reférences -observation du tableau virtuel de la page 2
Set D_new = CreateObject("scripting.dictionary")
For Cptr = 1 To UBound(T_new)
     Ref = T_new(Cptr, 1)
     Obs = T_new(Cptr, <gras>5)</gras>
     If Not D_new.exists(T_new(Cptr, 1)) Then D_new.Add Ref, Obs
Next

'parcoure le tableau virtuel de la page 1 Si la ref existe dans le dictionnaire _
on remplace l'ancienne observation par la nouvelle
For Cptr = 1 To UBound(T_old)
     If D_new.exists(T_old(Cptr, 1)) Then T_old(Cptr, 3) = D_new.Item(T_old(Cptr, 1))
 Next
 
 'restitution des nouvelles obsevations en feuille 1
 With Sheets(1)
     .Range("A1:C" & Cptr) = T_old
     .Select
 End With
End Sub
        0
      5. Boucle
        Bonjour,

        La macro fonctionne bien dans mon fichier test mais une fois reportée sur mon "vrai" tableur elle ne veut plus m'aider!

        la ligne => If Not D_new.exists(T_new(Cptr, 1)) Then D_new.Add Ref, Obs pose problème.
        Le problème doit venir de moi car j'ai voulu modifier la plage de sélection de la page 1, la passant de (A1,C) à (C4,E).

        Voici le lien de mon fichier => http://cjoint.com/data3/3FkjjmVQIbw.htm

        Option Explicit

        Sub actualiser_commentaire()
        Dim Derlig As Integer, T_new(), T_old()
        Dim D_new As Object
        Dim Cptr As Integer, Ref As String * 9, Obs As String

        'mémorisation des tableaux Excel en Ram
        With Sheets("Base de donnée commentaire")
        Derlig = .Columns("C").Find("*", , , , , xlPrevious).Row
        T_old = .Range("C4:E" & Derlig).Value
        End With
        With Sheets("MAJ")
        Derlig = .Columns("C").Find("*", , , , , xlPrevious).Row
        T_new = .Range("C2:G" & Derlig).Value
        End With
        'création des couple Reférences -observation du tableau virtuel de la page 2
        Set D_new = CreateObject("scripting.dictionary")
        For Cptr = 1 To UBound(T_new)
        Ref = T_new(Cptr, 1)
        Obs = T_new(Cptr, 5)
        If Not D_new.exists(T_new(Cptr, 1)) Then D_new.Add Ref, Obs
        Next

        'parcoure le tableau virtuel de la page 1 Si la ref existe dans le dictionnaire _
        on remplace l'ancienne observation par la nouvelle
        For Cptr = 1 To UBound(T_old)
        If D_new.exists(T_old(Cptr, 1)) Then T_old(Cptr, 3) = D_new.Item(T_old(Cptr, 1))
        Next

        'restitution des nouvelles obsevations en feuille 1
        With Sheets("Base de donnée commentaire")
        .Range("C4:E" & Cptr) = T_old
        .Select
        End With
        End Sub
        0

    Discussions similaires

    Transformer un chiffre en lettres dans excel sans macro
    vincentphilippos

    6 réponses
    recup couleur de cellule sans macro
    magouero

    7 réponses