Boucle FOR qui se répète trop de fois Excel VBA

Le 27/06/2014 à 09:48

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 (au cas ou ça peut aider)

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
Le 27/06/2014 à 13:16

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
Le 28/06/2014 à 20:54

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

Le 28/06/2014 à 23:11

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
Le 29/06/2014 à 15:27

Okay ça marche, merci beaucoup

Rechercher des sujets similaires à "boucle qui repete trop fois vba"