Boucle FOR qui se répète trop de fois Excel VBA
Bonjour,
Je suis une très grande débutante en VBA (j'ai commencé à apprendre lundi...) et on m'a demandé de faire une macro sur Excel.
J'ai fait une Boucle For dans mon programme mais le problème est qu'elle se répète trop de fois (je devrai obtenir une quarantaine de ligne, mais j'en obtiens presque 500).
A quoi serait-du le problème et comment faire pour le régler?
Voici la boucle en question:
Dim i As Integer
Dim j As Integer
Dim derligB As Long
Dim derligE As Long
Dim derlig2 As Long
derligB = Sheets("MACRO").Range("B65536").End(xlUp).Row
derligE = Sheets("MACRO").Range("E65536").End(xlUp).Row
For i = 2 To derligB
For j = 1 To derligE
If Sheets("MACRO").Range("B" & i).Value = Sheets("MACRO").Range("E" & j).Value Then
Sheets("MACRO").Range("C" & i).Value = Sheets("MACRO").Range("F" & j).Value
Else
derlig2 = Sheets("MACRO").Range("B65536").End(xlUp).Row + 1
Sheets("MACRO").Range("B" & derlig2).Value = Sheets("MACRO").Range("E" & j).Value
Sheets("MACRO").Range("C" & derlig2).Value = Sheets("MACRO").Range("F" & j).Value
End If
Next j
Next i
Merci d'avance de votre aide que vous pourrez apporter
Bonne journée!
Ah voici le code en entier
Sub Macro1()
'
' Macro1 Macro
'
'C/P des colonnes commandes et dates de livraisons
Sheets("CRNET-CDE").Range("C:C").Copy Destination:=Sheets("MACRO").Range("A1")
Sheets("CRNET-CDE").Range("F:F").Copy Destination:=Sheets("MACRO").Range("B1")
Sheets("CRNET-CDE").Select
Range("G1:AH29").Select
Selection.Copy
Sheets("MACRO").Select
Range("I1").Select
ActiveSheet.Paste
Range("I21").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(R[-19]C:R[-1]C)"
Range("I21").Select
Selection.AutoFill Destination:=Range("I21:AJ21"), Type:=xlFillDefault
Range("I21:AJ21").Select
Range("AG22").Select
Range("I21:AJ21").Select
Selection.Copy
Range("I22").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I2:AJ21").Select
Range("I21").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("I1:AJ2").Select
Selection.Copy
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("H1:AO2").Select
Selection.Delete Shift:=xlToLeft
Dim i As Integer
Dim j As Integer
Dim derligB As Long
Dim derligE As Long
Dim derlig2 As Long
derligB = Sheets("MACRO").Range("B65536").End(xlUp).Row
derligE = Sheets("MACRO").Range("E65536").End(xlUp).Row
For i = 2 To derligB
For j = 1 To derligE
If Sheets("MACRO").Range("B" & i).Value = Sheets("MACRO").Range("E" & j).Value Then
Sheets("MACRO").Range("C" & i).Value = Sheets("MACRO").Range("F" & j).Value
Else
derlig2 = Sheets("MACRO").Range("B65536").End(xlUp).Row + 1
Sheets("MACRO").Range("B" & derlig2).Value = Sheets("MACRO").Range("E" & j).Value
Sheets("MACRO").Range("C" & derlig2).Value = Sheets("MACRO").Range("F" & j).Value
End If
Next j
Next i
'mise en page (supression colonnes, ordre chrono, retirer la mise en forme
Columns("D:F").Delete
End Sub
Bonjour,
proposition de correction.
Dim i As Integer
Dim j As Integer
Dim derligB As Long
Dim derligE As Long
Dim derlig2 As Long
derligB = Sheets("MACRO").Range("B65536").End(xlUp).Row ' dernière ligne colonne B
derligE = Sheets("MACRO").Range("E65536").End(xlUp).Row ' dernière ligne colonne E
derlig2 = derligB ' pointeur de ligne pour l'ajout de nouvelle ligne
For i = 1 To derligE 'on parcourt toutes les lignes jusqu'à la fin de la colonne E
Set re = Sheets("MACRO").Range("B1:B" & derligB).Find(Sheets("MACRO").Range("E" & i), _
lookat:=xlWhole) 'on recherche la valeur de la colonne E dans la colonne B
If re Is Nothing Then 'si on ne la trouve pas, on ajoute une ligne en colonne B
derlig2 = derlig2 + 1
Sheets("MACRO").Range("B" & derlig2).Value = Sheets("MACRO").Range("E" & i).Value
Sheets("MACRO").Range("C" & derlig2).Value = Sheets("MACRO").Range("F" & i).Value
Else 'si on l'a trouvée, on écrase le contenu de la colonne C par le contenu de la colonne F
Sheets("MACRO").Range("C" & re.Row).Value = Sheets("MACRO").Range("F" & i).Value
End If
next i
Bonjour h2s04, merci beaucoup d'avoir répondu !
ça marche super maintenant! Vous êtes génial !
L'erreur venait d'où ? (pour que je puisse comprendre)
Bonne soirée et merci encore !
Laura Soe
Bonsoir,
ce que j'ai compris que tu voulais que ton programme fasse.
Pour chaque cellule de la colonne E
si le contenu de E se trouve en colonne B, on copie F dans C
sinon on ajoute une ligne où l'on copie E dans B et F dans C
ce que fait ton programme :
pour chaque cellule de la colonne B,
pour chaque cellule de la colonne E 'en fait ici tu recherches dans la colonne E si la valeur de B est présente
si le contenu de B =contenu de E, on copie F dans C ' tu as trouvé la valeur, il faut sortir de la boucle E
sinon on ajoute une nouvelle ligne où l'on copie E dans B et F dans C ' en fait, il ne faut pas ajouter de ligne maintenant, mais mais continuer la boucle de recherche et à la fin de la boucle de recherche ajouter la ligne si la valeur n'a pas été trouvée.
ce qui fait que pour chaque valeur de E différentes de B, tu ajoutes autant de lignes, puis tu passes à la cellule suivante en colonne B et tu recrées autant de lignes (pour finir avec une nombre de lignes en colonnes B qui est de l'ordre de grandeur du nombre de lignes de B * nombre de ligne de E)
pour la recherche, j'ai utilisé l'instruction FIND, plutôt que de faire une boucle de recherche.
voici comment tu aurais pu programmer la boucle de recherche ainsi
For i = 2 To derligB
For j = 1 To derligE
If Sheets("MACRO").Range("B" & i).Value = Sheets("MACRO").Range("E" & j).Value Then
Sheets("MACRO").Range("C" & i).Value = Sheets("MACRO").Range("F" & j).Value
trouvé=true
exit for
End if
next j
if not trouvé then
'on n'a pas trouvé B dans E
'derlig2 = Sheets("MACRO").Range("B65536").End(xlUp).Row + 1
'Sheets("MACRO").Range("B" & derlig2).Value = Sheets("MACRO").Range("E" & j).Value
'Sheets("MACRO").Range("C" & derlig2).Value = Sheets("MACRO").Range("F" & j).Value
End If
trouvé=false
Next i
tu remarqueras que ta recherche permet de déterminer si B est dans E ou qu'il n'y est pas, et s'il n'y est pas, il n'y a rien à faire, car en fait ce que tu cherches c'est si E est dans B, il faut donc inverser les colonnes pour chercher E dans B.
et donc ta macro pourrait ressembler à ceci
For j = 1 To derligE
For i = 2 To derligB
If Sheets("MACRO").Range("B" & i).Value = Sheets("MACRO").Range("E" & j).Value Then
Sheets("MACRO").Range("C" & i).Value = Sheets("MACRO").Range("F" & j).Value
trouvé=true
exit for
End if
next i
if not trouvé then
'on n'a pas trouvé E dans B
derlig2 = Sheets("MACRO").Range("B65536").End(xlUp).Row + 1
Sheets("MACRO").Range("B" & derlig2).Value = Sheets("MACRO").Range("E" & j).Value
Sheets("MACRO").Range("C" & derlig2).Value = Sheets("MACRO").Range("F" & j).Value
End If
Next j
Okay ça marche, merci beaucoup