Excel VBA : Probleme enchainement boucles
Résolu
Eaheru
Messages postés
205
Statut
Membre
-
Eaheru Messages postés 205 Statut Membre -
Eaheru Messages postés 205 Statut Membre -
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 ! :)
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:
- Excel VBA : Probleme enchainement boucles
- Liste déroulante excel - Guide
- Word et excel gratuit - Guide
- Déplacer colonne excel - Guide
- Si ou excel - Guide
- Excel compter cellule couleur sans vba - Guide
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.
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.
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. :)