Sujet Précédent Sujet Suivant

Boucle

Résolu
maxxx08 Messages postés 35 Date d'inscription mercredi 25 mai 2011 Statut Membre Dernière intervention 3 mai 2012 - 27 juin 2011 à 10:33
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 - 27 juin 2011 à 12:47
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.

4 réponses

Réponse 1 / 4
bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 14
27 juin 2011 à 11:23
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+
3
Réponse 2 / 4
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 219
27 juin 2011 à 11:13
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
0
Réponse 3 / 4
bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 14
27 juin 2011 à 11:39
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+
0
Réponse 4 / 4
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 219
27 juin 2011 à 12:47
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
0
Rejoignez-nous