Excel 2007 VBA : Macro non exhaustive ?

Résolu/Fermé
Signaler
Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
-
Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
-
Bonjour,

Je tente, par la macro ci dessous, de recopier la valeur contenue en colonne BP du fichier 2 dans la colonne BP du fichier 1 si les valeurs de la colonne BK sont identiques dans les 2 fichiers. Et ce, pour toutes les lignes du fichier 2.

J'utilise une macro qui m'a été donnée ici, pour une autre recherche, mais je m'aperçois qu'elle ne me remonte qu'une partie des informations.
Elle parcours bien les plus de 2500 lignes car les quelques remontées sont un peu partout au fil des lignes, mais certains valeurs ne sont pas prises en compte.
La valeurs comprise en BP sont toujours des chaines de caracteres, elles inclues tous types de caractères accentués ou pas ainsi que les "\" ou "/"

Private Const fichier1 = "D:\tmp\fichier1.xls"
Private Const fichier2 = "D:\tmp\fichier2.xls"

Sub SearchZ()
Dim wk1 As Workbook
Dim wk2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim derlig1 As Long
Dim derlig2 As Long
Dim cel1
Dim cel2

Set wk1 = Workbooks.Open(fichier1)
Set wk2 = Workbooks.Open(fichier2)
Set ws2 = wk2.Worksheets(1)
derlig2 = ws2.Range("N65536").End(xlUp).Row

Set ws1 = wk1.Worksheets(1)
derlig1 = ws1.Range("BK65536").End(xlUp).Row

For Each cel1 In ws1.Range("BK2:BK" & derlig1)
For Each cel2 In ws2.Range("BK2:BK" & derlig2)
If cel1.Value = cel2.Value Then
ws1.Range("BP" & cel1.Row).Value = ws2.Range("BP" & cel2.Row).Value
End If
Next cel2
Next cel1

Set wk1 = Nothing
Set wk2 = Nothing
Set ws2 = Nothing
Set ws1 = Nothing

Windows("fichier1.xls").Activate

Chemin = "D:\tmp" & "\"
ActiveWorkbook.SaveCopyAs Chemin & "fichier3.xls"
'
' Fermeture du fichier
ActiveWorkbook.Close

End Sub


Votre aide serait grandement appréciée :) si vous avez une autre écriture pour assurer la fonction décrite plus haut, n'hésitez pas à me proposer, car je suis bloqué la.

5 réponses

Messages postés
918
Date d'inscription
samedi 21 novembre 2009
Statut
Membre
Dernière intervention
20 mars 2013
287
Bonsoir,
Dans ta macro, la valeur BP de la feuille 2 n'est recopiée dans BP de la feuille 1 que si les BK sont identiques : est-ce vraiment le cas ? Attention aux espaces ("toto" est différent de "toto " et de " toto")
@+
0
Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
20
Hello et merci pour ta réponse.
Concernant les valeurs de la "clé" de recopie, elle sont extraites tous les jours depuis une base de données. j'avais regardé si personne n'y avait inscrit un espace.. mais non
0
Messages postés
24286
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
22 janvier 2022
7 031
Bonjour,

Il faudrait un fichier exemple...
Dépose-le sur cijoint.fr et colle ici le lien fourni
eric
0
Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
20
Bonjour Éric,

J'ai préparé un petit exemple ici : http://www.cijoint.fr/cjlink.php?file=cj201009/cij0r9mWF2.zip
0
Messages postés
24286
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
22 janvier 2022
7 031
Re,

Et si tu donnais les références des cellules qui sont théoriquement égales et qui ne sont pas détectées ?
Tu vois je n'ai pas envie de contrôler un par un les milliers de tests effectués...

Accessoirement :
1) lorsque tu écris Dim derlig3, derlig4, derlig5, derlig6, derlig7, derlig8, derlig9, derlig10, derlig11, derlig12, derlig13, derlig14 As Long seule derlig14 est Long, les autres sont Variants
Il faut écrire Dim derlig3 as long, derlig4 as long, ...
2) plutôt que de faire 2 boucles imbriquées pour rechercher une valeur tu peux, à la place de la boucle intérieure, utiliser la méthode .find (voir aide excel vba). Ca sera beaucoup plus rapide (mais à faire plus tard si tu le désires, restons sur la question initiale)

eric
0
Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
20
Arf, je pensais que la déclaration des variables tel que je l'avais faite était correcte :( merci de cette précision.

Pour les lignes ou ca ne fonctionne pas le fichier se renouvelant chaque jour, je n'en dispose plus pour le moment (les commentaires ont étés perdus). Et je comprends bien que les milliers de tests ne t'emballent pas :)
0
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016
1 190
Bonjour tout le monde.

Tout à fait d'accord avec Eric, d'autre part pour faire 5 fois la même boucle ? On gagnerai du temps en faisant toutes les opérations dans la même boucle. De plus, les variables globales doivent déclarées tout en haut du module et non au milieu des procédures:

Option Explicit 

Private Const fich3 = "D:\tmp\save\fichier1.xls" 
Private Const fich4 = "D:\tmp\save\fichier2.xls" 

Sub Search() 
    SearchComments 
        SaveComments 
End Sub 

Sub SearchComments() 
Dim wk3 As Workbook 
Dim wk4 As Workbook 

Dim ws3 As Worksheet 
Dim ws4 As Worksheet 

Dim derlig3 As Long 
Dim derlig4 As Long 
Dim cel3 As Range 
Dim cel4 As Range 


    Set wk3 = Workbooks.Open(fich3) 
    Set wk4 = Workbooks.Open(fich4) 
    Set ws4 = wk4.Worksheets(1) 
    derlig4 = ws4.Range("BK65536").End(xlUp).Row 
      
    Set ws3 = wk3.Worksheets(1) 
    derlig3 = ws3.Range("BK65536").End(xlUp).Row 
     
    For Each cel3 In ws3.Range("BK2:BK" & derlig3) 
     
         
        For Each cel4 In ws4.Range("BK2:BK" & derlig4) 
            If cel3.Value = cel4.Value Then 
                ws3.Range("BO" & cel3.Row).Value = ws4.Range("BO" & cel4.Row).Value 
                ws3.Range("BP" & cel3.Row).Value = ws4.Range("BP" & cel3.Row).Value 
                ws3.Range("BQ" & cel3.Row).Value = ws4.Range("BQ" & cel3.Row).Value 
                ws3.Range("BR" & cel3.Row).Value = ws4.Range("BR" & cel3.Row).Value 
                ws3.Range("BT" & cel3.Row).Value = ws4.Range("BT" & cel3.Row).Value 
            End If 
        Next cel4 
    Next cel3 
      
Set wk4 = Nothing 
Set wk3 = Nothing 
Set ws4 = Nothing 
Set ws3 = Nothing 
      
End Sub


«Ce que l'on conçoit bien s'énonce clairement, Et les mots pour le dire arrivent aisément.»
Nicolas Boileau
0
Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
20
Merci a vous deux !
Effectivement mes connaissances en VB sont très récentes et j'apprends sur le tas.
J'avais bien essayé de faire effectuer les 5 recherches sans parvenir à un résultat.
Au final j'ai donc opté pour 5 boucle successives (sachant que le temps de traitement serait important).
Mais bon, le résultat n'était pas probant non plus.

Polux,
Je vais tenter d'adapter ta routine dans mon flux, merci beaucoup de ton aide.

Eric,
Je vais effectuer aussi la recherche sur la fonction "find" ca pourra m'être utile pour le futur :)

Merci de votre disponibilité
0
Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
20
La macro tel qu'écrite par Polux a fonctionné parfaitement !
J'ai juste corrigé la petite erreur de copié/collé tel que ci dessous :

ws3.Range("BO" & cel3.Row).Value = ws4.Range("BO" & cel4.Row).Value
ws3.Range("BP" & cel3.Row).Value = ws4.Range("BP" & cel4.Row).Value
ws3.Range("BQ" & cel3.Row).Value = ws4.Range("BQ" & cel4.Row).Value
ws3.Range("BR" & cel3.Row).Value = ws4.Range("BR" & cel4.Row).Value
ws3.Range("BT" & cel3.Row).Value = ws4.Range("BT" & cel4.Row).Value


La première ligne était ok
0
Messages postés
918
Date d'inscription
samedi 21 novembre 2009
Statut
Membre
Dernière intervention
20 mars 2013
287
Bonjour,
Juste en complément de ce qui a été dit, pour gagner en rapidité d'execution, tu peux également désactiver la mise à jour de l'affichage le temps du calcul puis le réactiver :
Application.ScreenUpdating=False 
en début de procédure puis
Application.ScreenUpdating=True 
juste avant le End Sub.
@+
0
Messages postés
197
Date d'inscription
mercredi 23 juin 2010
Statut
Membre
Dernière intervention
12 mars 2018
20
Bonne idée, merci :)
0