boucleRésolu

Question

Bonjour tout le monde,


info : Cette boucle permet de comparer les cellules de la colonne C.
Ces données sont des heures.
0.0003 = 10 secondes
donc par exemple si entre C10 et C11 l'écart est plus petit que 0.0003 alors suppression de la ligne se trouvant en dessous.

Voici ma procédure:


Public nbenreg, ligne, col As Integer
Public avt_nb_suppr As String
Public aps_nb_suppr As String
Public avt_nb_restant As String
Public aps_nb_restant As String
Public avt_pourcentage As String
Public aps_pourcentage As String
Public nb_cells_before

Sub process()

    nbenreg = 0
    ligne = 2
    col = 1
    a = 0
    nb_cells_after = 0
    v = 0
    avt_nb_suppr = "Vous avez supprimé"
    aps_nb_suppr = "ligne(s)"
    avt_nb_restant = "il vous reste maintenant"
    aps_nb_restant = "saisie(s)"
    avt_pourcentage = "ce qui représente"
    aps_pourcentage = "% de données valable"
    nb_cells_before = Application.WorksheetFunction.CountA(Feuil1.Range("$A:$A"))
       
    Do While a <> ""
       a = Worksheets(Sheets(1).Name).Cells(ligne, col).Value
       If (Worksheets(Sheets(1).Name).Cells(ligne, col).Value = Worksheets(Sheets(1).Name).Cells(ligne + 1, col).Value) Then
            If ((Worksheets(Sheets(1).Name).Cells(ligne + 1, col + 2).Value - Worksheets(Sheets(1).Name).Cells(ligne, col + 2).Value) < 0.0003) Then
            Worksheets(Sheets(1).Name).Rows(ligne).Select ' effacer la première pièce (doublon)
            Selection.Delete Shift:=xlUp
            v = v + 1
            End If
       Else
       Worksheets(Sheets(1).Name).Cells(ligne, col + 61).Value = 0
       End If
    ligne = ligne + 1
    Loop
ligne = ligne - 2

nb_cells_after = Application.WorksheetFunction.CountA(Feuil1.Range("$A:$A"))



MsgBox avt_nb_suppr & vbLf & _
         v & vbLf & _
         aps_nb_suppr & vbLf
         
         
MsgBox avt_nb_restant & vbLf & _
        nb_cells_after & vbLf & _
        aps_nb_restant & vbLf
        
 f = nb_cells_after * 100 / nb_cells_before
 f = Format(f, "#0.00")
 
 MsgBox avt_pourcentage & vbLf & _
        f & vbLf & _
        aps_pourcentage & vbLf
        
Menu.CommandButton1.Visible = False

End Sub
    


Dans un souci de rapidité j'aimerai savoir si il est possible d'améliorer cette boucle. Car cette boucle peut durer plus de 30 secondes ce qui est beaucoup trop long.

bigfish_le vrai · Accepted Answer

Salut,

pour gagner du temps avec excel 3 basiques :

- éviter les sélections
- désactiver la mise à jour graphique
- désactiver le recalcule automatique

concrètement cela donne : (non testé)


Sub process()

    nbenreg = 0
    ligne = 2
    col = 1
    a = 0
    nb_cells_after = 0
    v = 0
    avt_nb_suppr = "Vous avez supprimé"
    aps_nb_suppr = "ligne(s)"
    avt_nb_restant = "il vous reste maintenant"
    aps_nb_restant = "saisie(s)"
    avt_pourcentage = "ce qui représente"
    aps_pourcentage = "% de données valable"
    nb_cells_before = Application.WorksheetFunction.CountA(Feuil1.Range("$A:$A"))
      
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Do While a <> ""
        With Worksheets(Sheets(1).Name) 'poue simplifier l&#8217;écriture (attention aux points)
            a = .Cells(ligne, col).Value
            If .Cells(ligne, col).Value = .Cells(ligne + 1, col).Value Then
                 If (.Cells(ligne + 1, col + 2).Value - .Cells(ligne, col + 2).Value) < 0.0003 Then
                    .Rows(ligne).Delete Shift:=xlUp
                    v = v + 1
                 End If
            Else
                .Cells(ligne, col + 61).Value = 0
            End If
       End With
    ligne = ligne + 1
    DoEvents 'pour eviter les ennuis
    Loop
    Application.Calculation = xlCalculationAutomatic
    Application.Calculate 'lance le calcul
    Application.ScreenUpdating = True

ligne = ligne - 2

nb_cells_after = Application.WorksheetFunction.CountA(Feuil1.Range("$A:$A"))



MsgBox avt_nb_suppr & vbLf & _
         v & vbLf & _
         aps_nb_suppr & vbLf
         
         
MsgBox avt_nb_restant & vbLf & _
        nb_cells_after & vbLf & _
        aps_nb_restant & vbLf
        
 f = nb_cells_after * 100 / nb_cells_before
 f = Format(f, "#0.00")
 
 MsgBox avt_pourcentage & vbLf & _
        f & vbLf & _
        aps_pourcentage & vbLf
        
Menu.CommandButton1.Visible = False

End Sub

A+

ucfoutu · Answer

Bonjour,

1) Feuil1.Range("$A:$A") est maladroit (toute la colonne !). Ne la parcours que jusqu'où nécessaire (dernière ligne non vide de ta colonne)
2) utiliser Select pour ensuite travailler avec la sélection est malheureux
est malheureux (on ne le répètera pas assez) et transforme ta feuille en arbre de Noël !
Pointe directement, ainsi (exemple) :
 Worksheets(Sheets(1).Name).Rows(ligne).Delete Shift:=xlUp

3) L'affichage lui-même bouffe du temps !
inhibe-le au début de la procédure et réactive-le à la fin (utilisation de ScreenUpdating)

____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée"  en bas d'une solution adéquate est

bigfish_le vrai · Answer

ucfoutu,

si tu regarde bien le code les lignes:

nb_cells_before = Application.WorksheetFunction.CountA(Feuil1.Range("$A:$A"))

nb_cells_after = Application.WorksheetFunction.CountA(Feuil1.Range("$A:$A"))

ne servent qu'a donner une info du nombre de ligne traitées.

la boucle quand à elle, est bien limitée au nombre de ligne nécessaires par 

While a <> ""

A+

ucfoutu · Answer

Oui, bigfish_le vrai : bien vu .
Je ne veux pour l'instant pas troubler le demandeur, mais reviendrai plus tard (quand il aura assimilé ce que nous lui avons déjà dit, pas avant) avec le code le plus adapté à la célérité. Il ne supprimera les lignes nécessaires qu'in fine et d'un seul coup. 

____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée"  en bas d'une solution adéquate est

Boucle

4 réponses

Votre réponse

Discussions similaires