Souci avec une macro
Résolu
Boucle
-
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
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
A voir également:
- Souci avec une macro
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Jitbit macro recorder - Télécharger - Confidentialité
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Macro maker - Télécharger - Divers Utilitaires
- Macro word - Guide
4 réponses
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
"Boucle et "omelli" m^me Personne ?
https://forums.commentcamarche.net/forum/affich-27964366-excel-macro-rechercher-puis-copier-dans-une-autre-feuille#newanswer
Michel
Omelli
Messages postés
6
Date d'inscription
Statut
Membre
Dernière intervention
1
Ca y ressemble, mais non !
Boucle
Non mais manifestement nous avons un problème similaire.
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
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
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
https://www.cjoint.com/
puis copier l'adresse du lien et la coller dans le message de réponse
proposition de macro rapide (4500 lignes)
Ton classeur avec la macro
https://www.cjoint.com/?3FhpaJOQ2WY
Michel
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
Bonjour,
Effectivement, je m'étais croisé les yeux, excuses moi....
macro corrigée
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
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
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