Trucs pour boucle for n=1 to 55000 (?)

[Kargos]

Bonjour à tous et merci de prendre quelques instants pour lire ces lignes,

J'ai dernièrement découvert les vertus de l'utilisation de Macro en Excel et depuis, j'en abuse (!)

Toutefois, je suis présentement confronté à un problème de durée d'exécution dans une boucle "For ... Next". Et je me demande si certains d'entre vous n'auraient pas des trucs pour faire sauver du temps.

Je vous explique mon cas:
Sous Excel 2003, je crée une feuille excel en prenant des informations dans différents rapports provenant de bases de données diverses et donc, avec des formats différents.
Pour pouvoir rendre mon fichier excel fonctionnel, j'essaie de lui donner une allure plus "belle".
Par contre, à un certain point dans mon exécution de code, je me retrouve avec environ 55 000 lignes de données dont environ 25 000 sont vides.
Je souhaite donc supprimer toutes les lignes vides.

Petit hic, dans mes lignes non-vides, les cellules ne sont pas toutes remplies, et donc je ne peux pas utiliser la fonction IsEmpty() sur une seule cellule de la ligne. J'ai aussi essayé d'utiliser IsEmpty() sur toutes les cellules de la ligne (12) avec un code du genre:

For n = 55 000 To 1 Step -1
If IsEmpty(Cells(n,1)) and IsEmpty(Cells(n,2)) and ... and IsEmpty(Cells(n,12) Then
Rows(n).Delete
End If
Next


Présentement, mon code ressemble à ceci:

For n = 55 000 To 1 Step -1
Set verif = Range(Cells(n, 1), Cells(n, 15))
If WorksheetFunction.CountBlank(verif) = verif.Count Then
Rows(n).Delete
End If
Next

J'ai aussi essayé avec

For n = 55 000 To 1 Step -1
Set verif = Range(Cells(n, 1), Cells(n, 15))
If Application.Counta(verif) = 0 Then
Rows(n).Delete
End If
Next

Si vous connaissez des trucs pour faire exécuter ce genre de code plus rapidement, je vous prie de bien vouloir me les partager. Je vous en serais extremement reconnaissant.

Merci Beaucoup

 

[meliokan]

Re : Trucs pour boucle for n=1 to 55000 (?)

j'ai fais un bout de code qui efface toutes les lignes vide en 0.8125 s !

ca interresse quelqu'un?

je suppose que oui, le temps de le mettre au propre et je vous l'envoie

 

[meliokan]

Re : Trucs pour boucle for n=1 to 55000 (?)

J'ai fais ça avec l'enregistreur de macro, pas eu le courage de faire un nettoyage.

 

[smotty]

Re : Trucs pour boucle for n=1 to 55000 (?)

Bonjour Meliokan,

le mien est plus court que le tien... je parle du temps

en fonction de la discontinuité des lignes vides , le timer m'indique entre 2,5 secondes et 4 secondes.

C'est assez rapide.

Vois ma dernière solution, à adapter en excel 2003 pour le tri car je suis en 2007. résultat 1,54 secondes tout compris contre 4 secondes pour ta méthode sur le même type de discontinuité des ligne vides.

Il n'y a aucune boucle, donc résultat ultra rapide

En tout cas, pas mal du tout

 

[ROGER2327]

Re : Trucs pour boucle for n=1 to 55000 (?)

Bonjour à tous

J'ai regroupé quelques propositions dans le classeur joint.
J'ai repris :

1. La solution de JNP dont les performances se dégradent très vite lorsque le nombre de lignes à traiter augmente.
2. Une solution fondée sur la précédente. Quelques petites modifications apportent un accroissement notable des performances.
3. Ma première proposition, très légèrement modifiée.
4. Ma première proposition, largement simplifiée.
5. La proposition de laetitia90, après une correction indispensable car la version initiale ne respecte pas l'intégrité des données numériques. Il faut typer t2() As Variant, et non t2() As String ! Ce faisant, on obtient un code assez rapide, avec une structure très proche de ma première proposition (la différence principale étant la limitation à quinze colonnes pour le code de laetitia90).
6. La proposition de Fo_rum, à peine modifiée. Le fonctionnement est voisin de ma proposition simplifiée (si ce n'est la limitation à 55_000 lignes).

Je n'ai pas retenu les propositions de smotty, écrites spécifiquement pour Excel2007, ni celle de meliokan qui ne me semble pas répondre à la question initiale : entre autres inconvénients, elle supprime des lignes non vides si leur première cellule est vide.

La feuille de test est la feuille Feuil3. Voici un exemple de résultats obtenus sur ma machine (temps en secondes) :​

Nombre de__ROGER2327__ROGER2327_laetitia90_____Fo_rum________JNP________JNP
___lignes_simplifiée___________________________________améliorée___________
___________________________________________________________________________
________1________0,1________0,2________0,5________0,9________0,1________3,6
________2________0,1________0,2________0,5________0,9________0,1________3,6
________5________0,1________0,2________0,5________0,9________0,2________3,7
_______10________0,1________0,2________0,5________0,9________0,2________3,7
_______20________0,1________0,2________0,5________0,9________0,2________3,8
_______50________0,1________0,2________0,5________0,9________0,4__________4
______100________0,1________0,2________0,5________0,9________0,7________4,7
______200________0,1________0,2________0,5________0,9________1,2________6,5
______500________0,1________0,3________0,5__________1________2,9_______18,2
_____1000________0,1________0,3________0,5__________1________5,5_________51
_____2000________0,2________0,3________0,6__________1_______11,4_____------
_____5000________0,3________0,5________0,7________1,1_______41,5_____------
____10000________0,5________0,8________1,1________1,3_____------_____------
____20000________0,9________2,2________2,4________1,6_____------_____------
____50000________2,1________9,8_______10,1________2,7_____------_____------
____55000________2,3_______11,6_______11,9________2,9_____------_____------
____65536________2,8_________16_______16,3_____------_____------_____------​

ROGER2327
#3919

Jeudi 5 Tatane 137 (Saint Arsouille, patricien, SQ)
30 Messidor An CCXVIII
2010-W28-7T08:26:44Z

 

[JNP]

Re : Trucs pour boucle for n=1 to 55000 (?)

Re ,
Très belle statistique Roger .
Vu qu'on est parti pour le fun ...
Je suis désolé, mais j'étais parti ce matin sur une solution valable uniquement sous 2007 , vu que je trie toutes les colonnes, soit 15 tris.
Par contre, j'ai tenu compte des facteurs de départ, et seule les lignes totalement vides sont éliminées.
Pour le remplissage, je suis parti de la suggestion de Laetitia d'une ligne sur 2.
J'ai ajouté un InputBox pour choisir le nombre de lignes, mais je suis limité en 65536 en XLS. Par contre, j'ai grimpé les tests à 100000 en XLSM.
Les tests effectués donnent 1s stable à 50000 et 2s stable à 100000, pour le double au triple pour Smotty et Meliokan .
Bon dimanche

 

[Cousinhub]

Re : Trucs pour boucle for n=1 to 55000 (?)

Bonjour,

Je peux jouer?

Roger, en partant de ton fichier, avec toutes les données en Feuil2, et extraction vers Feuil1 (rien ne nous empêche de supprimer la Feuil2 ensuite), j'obtiens 0.35 s à 0.7 s pour 65 000 lignes.....
Limité à 255 colonnes sur Xl2003.....

le code :

Sub test_bhbh()
Dim DerLig As Long
Dim DerCol As Integer
Dim T
T = Timer
With Sheets("Feuil2")
    DerLig = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    DerCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    .Range("A1", .Cells(DerLig, DerCol)).Name = "base"
    .Cells(2, DerCol + 1).FormulaR1C1 = "=COUNTA(RC[-" & DerCol & "]:RC[-1])>0"
    .Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range(.Cells(1, DerCol + 1), .Cells(2, DerCol + 1)), _
        CopyToRange:=Sheets("Feuil1").Range("A1"), Unique:=False
    .Cells(2, DerCol + 1).Clear
End With
MsgBox Timer - T
End Sub

Je ne sais pas si c'est du jeu (extraction vers un autre onglet), mais ça marche, donc....

Bon Dimanche

 

[ROGER2327]

Re : Trucs pour boucle for n=1 to 55000 (?)

Re...
Bonjour bhbh

Idée intéressante, mais qui pose quelques problèmes :

1. Plantage sur la ligne

   [COLOR="DarkSlateGray"][B]    .Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range(.Cells(1, DerCol + 1), .Cells(2, DerCol + 1)), _
           CopyToRange:=Sheets("Feuil1").Range("A1"), Unique:=False[/B][/COLOR]

2. Ce problème, supposé résolu, il restera que la procédure crée des noms dans le classeur. Il faudra donc préalablement s'assurer que ces noms ne sont pas déjà utilisés. Il faudra également prévoir leur élimination en fin de procédure afin de rendre l'endroit aussi propre qu'on aimerait le trouver en entrant...
3. La procédure appliquée à une feuille contenant moins de deux lignes de données échoue : un contrôle s'impose, même si l'éventualité d'une telle situation est minime.
4. La portabilité d'une telle procédure est problématique : on sait que Bill se soucie comme d'une guigne de la compatibilité d'une version à la suivante (sauf lorsqu'il s'agit de perpétuer des absurdités genre 29 février 1900).
   C'est pourquoi je préfère en rester à des structures basiques afin de ne pas obliger le client à la réécriture du code au prochain changement de version — en espérant que For i = 1 To 20 : Next i restera valable dans la prochaine version de VBA —. Les déboires rencontrés plus haut avec Sort montrent que ce souci n'est pas un fantasme...

Ceci dit, si vous pouvez développer cette procédure, elle sera probablement plus rapide que celles proposées jusqu'ici. Notre ami a de la chance d'avoir suscité autant de réponses...​

ROGER2327
#3922

Jeudi 5 Tatane 137 (Saint Arsouille, patricien, SQ)
30 Messidor An CCXVIII
2010-W28-7T23:18:14Z

 

[JNP]

Re : Trucs pour boucle for n=1 to 55000 (?)

Re ,

La portabilité d'une telle procédure est problématique : on sait que Bill se soucie comme d'une guigne de la compatibilité d'une version à la suivante (sauf lorsqu'il s'agit de perpétuer des absurdités genre 29 février 1900).
C'est pourquoi je préfère en rester à des structures basiques afin de ne pas obliger le client à la réécriture du code au prochain changement de version — en espérant que For i = 1 To 20 : Next i restera valable dans la prochaine version de VBA —. Les déboires rencontrés plus haut avec Sort montrent que ce souci n'est pas un fantasme...

Pour vous rassurez, 2010 (VBA 7) accepte encore For i = 1 To 20 : Next i. Mais il est vrai que les prochaines versions pourraient adopter la syntaxe VB.net

For i as Integer = 1 To 20

ce qui poserait des problèmes de compatibilité descendante ...
En général, la compatibilité ascendante est assez bien respectée, l'ancien tri 2003 est accepté sous 2007, c'est le nouveau tri 2007 qui n'est pas accepté sous 2003. Et ce serait dommage que pour conserver une compatibilité 100%, on se prive des nouveaux outils mis à disposition.
Par contre, c'est vrai que parfois, une fonctionnalité ne passe plus, comme InsertRowRange sur ce fil, plus exactement, elle ne renvoie plus ce qu'on attendait avant.
Ce qui est dommageable, c'est que 2007 prévient de problème de compatibilité à l'enregistrement antérieur, mais ne scanne pas du tout le VBA.
Maintenant, étant passé en 2010, mais surtout en version 64 bits, là, des nouveaux problèmes se posent... Mais ce n'est pas pour cela que je vais faire marche arrière .
Bonne journée

 

[Cousinhub]

Re : Trucs pour boucle for n=1 to 55000 (?)

Bonjour,

En réponse aux observations apportées par Roger :

Plantage sur la ligne....

Effectivement, je ne "nettoyai" pas la feuille avant : Résolu

il restera que la procédure crée des noms dans le classeur.

Je n'en créé plus : Résolu

La procédure appliquée à une feuille contenant moins de deux lignes de données échoue

Contrôle rajouté : Résolu

La portabilité d'une telle procédure est problématique

Je pense que le filtre avancé devrait perdurer (mais ceci n'engage que moi). Sinon, je pense que bon nombre d'applications seraient à revoir.... : Non Résolu, mais confiant...

Nouveau code (± 1 seconde pour 65000 lignes) :

Sub test_bhbh()
Dim DerLig As Long
Dim DerCol As Integer
Dim T
Application.ScreenUpdating = False
T = Timer
Feuil1.Cells.Clear
With Sheets("Feuil2")
    DerLig = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    If DerLig < 2 Then
        MsgBox "pas de données"
        Exit Sub
    End If
    DerCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    .Cells(2, DerCol + 1).FormulaR1C1 = "=COUNTA(RC[-" & DerCol & "]:RC[-1])>0"
    .Range("A1", .Cells(DerLig, DerCol)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range(.Cells(1, DerCol + 1), .Cells(2, DerCol + 1)), _
        CopyToRange:=Sheets("Feuil1").Range("A1"), Unique:=False
    .Cells(2, DerCol + 1).Clear
End With
MsgBox Timer - T
End Sub

Le fichier :

 

[Kargos]

Re : Trucs pour boucle for n=1 to 55000 (?)

Je tiens à vous remercier tous très chaleureusement pour ces nombreuses réponses et solutions.

J'en profite également pour vous exposer un autre problème du même type.

Avec ces lignes (maintenant rendu 35 000) qui listent, en passant, des équipement, je souhaite trouvé une date correspondante qui se trouve sur une autre feuille.

(je vais joindre un fichier)

Sur la feuille "Equipement" j'ai mes 35 000 lignes et je souhaite y ajouter une date en colonne 9. Les equipement sont listés du type: "G05-DT-23-01"
Sur la feuille "Document" je dois trouvé dans le liste des 10 000 documents ceux traitant des équipements en question, et retouner la date.
Par contre, les documents n'ont pas le même titre que les équipements, mais contiennent le nom, exemple: "Quality Control Plan - (G05-DT-23-01)"

Mon code est dans le Module4 du fichier. En fait, j'utilise la fonction "Find" avec un offset pour garder la date au lieu du nom. Par contre, ma macro prend plus de 5 minutes à s'exécuter et je voulais savoir si vous n'auriez pas quelques trucs encore pour simplifer ce monstre..

Également, si c'est possible, j'aimerais pouvoir conservé la date la plus lointaine dans le cas où l'équipement se retrouve dans plusieurs documents différents. Pour ce faire, j'avais trouvé une macro sur internet (qui est également jointe dans le Module5) mais je n'arrive pas à l'adapter à mon cas.

Je suis conscient que le problème n'est pas simple et que probablement que je l'expose bien mal . Si jamais vous avez besoin de précisions, je vous prie de ne pas hésiter à me les demander.

 

[smotty]

Re : Trucs pour boucle for n=1 to 55000 (?)

Bonjour,

j'en suis à 13 secondes sur 35000 lignes:

Sub trouvedate()

    Dim det As Worksheet
    Dim doc As Worksheet
    Dim foundcell As Range
    Dim Champs As Range
    Dim ChampsRech As Range
    Dim bldatefound As Boolean
    Dim DateMax As Date
    Dim DateCell As Date
    Dim l As Long
    Dim cell As Range
    
    t = Timer
    
    Application.ScreenUpdating = False
    
    Set det = Worksheets("Equipment")
    Set doc = Worksheets("Document")
    
    With det
        l = .[B65535].End(xlUp).Row
        Set Champs = .Range(.Cells(2, 2), .Cells(l, 2))
    End With
    
    With doc
        l = .[D65535].End(xlUp).Row
        Set ChampsRech = .Range(.Cells(2, 4), .Cells(l, 4))
    End With
'boucle géante sur tout le document pour trouver la date correspondante
    
    For Each cell In Champs
        
        If cell <> "" Then
            bldatefound = False
            DateMax = CDate("01/02/1999")
            d = UCase(cell.Value)
            
            Set foundcell = ChampsRech.Find(d, , xlValues, xlPart)
            If Not foundcell Is Nothing Then
                
                adrdeb = foundcell.Address
                bldatefound = True
                Do
                    DateCell = CDate(foundcell.Offset(0, 5).Value)
                    'Debug.Print DateCell
                    If DateCell > DateMax Then DateMax = DateCell
                    Set foundcell = ChampsRech.FindNext(foundcell)
                Loop While Not foundcell Is Nothing And foundcell.Address <> adrdeb
            End If
            
'Si la date est passée, nous voulons la date d'aujourd'hui
            If bldatefound Then
                If DateMax > Date Then
                    cell.Offset(0, 7) = DateMax
                Else
                    cell.Offset(0, 7) = Date
                    cell.Offset(0, 7).NumberFormat = "yyyy-mm-dd"
                End If
            End If
        End If
    Next cell
    
    Application.ScreenUpdating = True
    
End Sub

cette fois c'est compatible 2003

cdt

smotty

 

[ROGER2327]

Re : Trucs pour boucle for n=1 to 55000 (?)

Re... (Avec retard)

(...) Nouveau code (± 1 seconde pour 65000 lignes) (...)

C'est effectivement très efficace, et probablement une meilleure solution que celles que j'ai testé.
Quand je parlais des noms qui pouvaient subsister dans le classeur après utilisation de la procédure, je pensais surtout à celui que crée le filtre élaboré.
Si l'utilisateur a défini son propre nom Extraction, il devra le rétablir après l'exécution de la procédure. Je propose donc une variante :

[COLOR="DarkSlateGray"][B]Sub test_bhbh_2()
Dim DerLig&, DerCol%
Dim i%, x As Object, y$, tf As Boolean
Dim t!
   Application.ScreenUpdating = False
   t = Timer
   Feuil1.Cells.Clear
   With Sheets("Feuil2")
      On Error GoTo E
      DerLig = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
      On Error GoTo 0
      If DerLig = 1 Then
         .Rows(1).EntireRow.Copy Destination:=Sheets("Feuil1").Range("A1")
      Else
         [COLOR="Sienna"]Set x = ThisWorkbook.Names
         If Not x Is Nothing Then
            For i = 1 To x.Count
               If x.Item(i).NameLocal = "Extraction" Then
                  y = x.Item(i)
                  tf = True
                  Exit For
               End If
            Next i
         End If[/COLOR]
         DerCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
         .Cells(2, DerCol + 1).FormulaR1C1 = "=COUNTA(RC[-" & DerCol & "]:RC[-1])>0"
         .Range("A1", .Cells(DerLig, DerCol)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range(.Cells(1, DerCol + 1), .Cells(2, DerCol + 1)), _
            CopyToRange:=Sheets("Feuil1").Range("A1"), Unique:=False
         .Cells(2, DerCol + 1).Clear
         [COLOR="Sienna"]If tf Then x.Item("Extraction").RefersTo = y Else x.Item("Extraction").Delete[/COLOR]
      End If
   End With
   MsgBox Timer - t
   Exit Sub
E:
   MsgBox "Pas de données."
End Sub[/B][/COLOR]

ROGER2327
#3949

Lundi 9 Tatane 137 (Saints Ecrase-Merdre, sectateurs, SQ)
4 Thermidor An CCXVIII
2010-W29-4T16:57:30Z