Souci avec une macro

Résolu
Boucle -  
 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

  1.
    michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour,

    "Boucle et "omelli" m^me Personne ?

    https://forums.commentcamarche.net/forum/affich-27964366-excel-macro-rechercher-puis-copier-dans-une-autre-feuille#newanswer

    Michel
    0
    1. Omelli Messages postés 8 Statut Membre 1
       
      Ca y ressemble, mais non !
      0
    2. Boucle
       
      Non mais manifestement nous avons un problème similaire.
      0
  2. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    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
  3. Boucle
     
    Non, je n'ai pas de doublon dans ma 1ere feuille.
    0
    1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      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
  4. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    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 Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      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 Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      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 -
tontong -

6 réponses
recup couleur de cellule sans macro
magouero -
JvDo -

7 réponses
convertir des chiffres en lettres avec une unique formule
FOUAD_9000 -
Mike-31 -

34 réponses