Excel VBA : Probleme enchainement boucles

Résolu/Fermé
Eaheru Messages postés 197 Date d'inscription mercredi 23 juin 2010 Statut Membre Dernière intervention 12 mars 2018 - 6 sept. 2010 à 09:51
Eaheru Messages postés 197 Date d'inscription mercredi 23 juin 2010 Statut Membre Dernière intervention 12 mars 2018 - 7 sept. 2010 à 14:11
Bonjour,

J'ai tenté d'adapter un boucle qui vérifie qu'une valeur présente en colonne BK d'un fichier 1 est présente en colonne BK d'un fichier 2, et si c'est le cas, copie la valeur de la cellule BO du fichier 1 dans la cellule BO du fichier 2.
Le but étant de remonter des informations d'un fichier à l'autre de jour en jour;

Hors la première boucle semble bien fonctionner, mais les 5 autres boucles que j'ai tenté d'imbriquer ne remonte rien :(

ci dessous le code de la routine :

<ital>
Private Const fich3 = "d:\tmp\fichier2_TMP2.xls"
Private Const fich4 = "d:\tmp\fichier1.xls"


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

Dim ws3 As Worksheet
Dim ws4 As Worksheet

Dim derlig3, derlig4, derlig5, derlig6, derlig7, derlig8, derlig9, derlig10, derlig11, derlig12, derlig13, derlig14 As Long
Dim cel3, cel4, cel5, cel6, cel7, cel8, cel9, cel10, cel11, cel12, cel13, cel14


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

' Remontée des "Commentaires 1" Colonne BK
For Each cel3 In ws3.Range("BK2:BK" & derlig3)
Application.DisplayStatusBar = True
Application.StatusBar = "Remontée des 'Commentaires 1' depuis le fichier 1"
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
End If
Next cel4
Next cel3



Set ws4 = wk4.Worksheets(1)
derlig6 = ws4.Range("BK65536").End(xlUp).Row
Set ws3 = wk3.Worksheets(1)
derlig5 = ws3.Range("BK65536").End(xlUp).Row

' Remontée des "commentaire 2" Colonne BP
For Each cel5 In ws3.Range("BK2:BK" & derlig5)
Application.StatusBar = "Remontée des 'Commentaires 2' depuis le fichier 1"
For Each cel6 In ws4.Range("BK2:BK" & derlig6)
If cel5.Value = cel6.Value Then
ws3.Range("BP" & cel5.Row).Value = ws4.Range("BP" & cel6.Row).Value
End If
Next cel6
Next cel5

Set ws4 = wk4.Worksheets(1)
derlig8 = ws4.Range("BK65536").End(xlUp).Row
Set ws3 = wk3.Worksheets(1)
derlig7 = ws3.Range("BK65536").End(xlUp).Row

' Remontée des "Remontée des 'Commentaires 3' depuis le fichier 1 Colonne BQ
For Each cel7 In ws3.Range("BK2:BK" & derlig7)
Application.StatusBar = "Remontée des 'Remontée des 'Commentaires 3' depuis le fichier 1"
For Each cel8 In ws4.Range("BK2:BK" & derlig8)
If cel7.Value = cel8.Value Then
ws3.Range("BQ" & cel7.Row).Value = ws4.Range("BQ" & cel8.Row).Value
End If
Next cel8
Next cel7


Set ws4 = wk4.Worksheets(1)
derlig10 = ws4.Range("BK65536").End(xlUp).Row
Set ws3 = wk3.Worksheets(1)
derlig9 = ws3.Range("BK65536").End(xlUp).Row

' Remontée des 'Commentaires 4' depuis le fichier 1 Colonne BR
For Each cel9 In ws3.Range("BK2:BK" & derlig9)
Application.StatusBar = "Remontée des 'Commentaires 4' depuis le fichier 1"
For Each cel10 In ws4.Range("BK2:BK" & derlig10)
If cel9.Value = cel10.Value Then
ws3.Range("BR" & cel9.Row).Value = ws4.Range("BR" & cel10.Row).Value
End If
Next cel10
Next cel9


Set ws4 = wk4.Worksheets(1)
derlig12 = ws4.Range("BK65536").End(xlUp).Row
Set ws3 = wk3.Worksheets(1)
derlig11 = ws3.Range("BK65536").End(xlUp).Row

' Remontée des 'Commentaires 5' depuis le fichier 1 Colonne BS
For Each cel11 In ws3.Range("BK2:BK" & derlig11)
Application.StatusBar = "Remontée des 'Commentaires 5 depuis le fichier 1 "
For Each cel12 In ws4.Range("BK2:BK" & derlig12)
If cel11.Value = cel12.Value Then
ws3.Range("BS" & cel11.Row).Value = ws4.Range("BS" & cel12.Row).Value
End If
Next cel12
Next cel11


Set ws4 = wk4.Worksheets(1)
derlig14 = ws4.Range("BK65536").End(xlUp).Row
Set ws3 = wk3.Worksheets(1)
derlig13 = ws3.Range("BK65536").End(xlUp).Row

' Remontée des 'Commentaires 6' depuis le fichier 1" Colonne BT
For Each cel13 In ws3.Range("BK2:BK" & derlig13)
Application.StatusBar = "Remontée des 'Commentaires 6' depuis le fichier 1"
For Each cel14 In ws4.Range("BK2:BK" & derlig14)
If cel13.Value = cel14.Value Then
ws3.Range("BT" & cel13.Row).Value = ws4.Range("BT" & cel14.Row).Value
End If
Next cel14
Next cel13



Application.DisplayStatusBar = False

Set wk4 = Nothing
Set wk3 = Nothing
Set ws4 = Nothing
Set ws3 = Nothing

End Sub

J'ai bien conscience que le code n'est pas propre, mais je sèche pour le nettoyer.
Donc si vous avez une idée, Merci d'avance ! :)
A voir également:

2 réponses

Bonjour,

6 fois la même boucle de boucle !!
Ca doit ramer ?

On peut le faire en une seule passe;
mais le problème est-il toujours d'actualité ?

A te lire.
0
Eaheru Messages postés 197 Date d'inscription mercredi 23 juin 2010 Statut Membre Dernière intervention 12 mars 2018 20
7 sept. 2010 à 14:11
Bonjour et merci du coup d'oeil, en fait le problème est traité sur un autre sujet (https://forums.commentcamarche.net/forum/affich-19104148-excel-2007-vba-macro-non-exhaustive Je vais noter celui ci comme résolu. :)
0