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

Kargos · 13 Juillet 2010

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

Habitude · 13 Juillet 2010

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

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

Si ce sont tous des chiffres, tu peux toujours utiliser la foncition somme

Code:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
For n = 55000 To 1 Step -1
If WorksheetFunction.Sum(Range(Cells(n, 1), Cells(n, 15))) = 0 Then Rows(n).Delete
Next
Application.ScreenUpdating = True
End Sub

Si il y autres choses que des chiffres
Tu peux concatener
Je pense même que c'est plus rapide que Sum

Code:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
For n = 55000 To 1 Step -1
    v = ""
    For i = 1 To 15: v = v & Trim(Cells(n, i)): Next i
    If v= "" Then Rows(n).Delete
Next n
Application.ScreenUpdating = True
End Sub

JNP · 13 Juillet 2010

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

Bonsoir Kargos, Habitude

,
A tester, mise en mémoire des lignes puis suppression unique

Code:

Sub Test()
Dim Plage As Range, I As Long, Flag As Boolean
Application.ScreenUpdating = False
For I = 1 To 55000
If Application.CountA(Range(Cells(I, 1), Cells(I, 15))) = 0 Then
If Flag = True Then
Set Plage = Union(Plage, Rows(I))
Else
Flag = True
Set Plage = Rows(I)
End If
End If
Next
Plage.Delete
Application.ScreenUpdating = True
End Sub

Bonne nuit

Ajout : Salut Smotty

smotty · 13 Juillet 2010

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

Bonsoir, Kargos, JNP, Habitude

avec une étape intermédiaire.

'ajouter une colonne "nombre de valeur"

dim C as range

range("O1:O55000").FormulaR1C1 = "=COUNT(RC[-13]:RC[-10])"

ensuite il reste plusqu'à trier selon la colonne "O" = 0

et supprimer en 1 seule fois les lignes à 0

cdt

smotty

ROGER2327 · 14 Juillet 2010

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

Bonsoir à tous

Essayez ceci :

Code:

[COLOR="DarkSlateGray"][B]Sub toto()
Dim i&, j&, n&, p&, oDat, sDat
   oDat = Range(Cells(1, 1), Cells(1, 1).SpecialCells(xlLastCell)).Value
   If IsEmpty(oDat) Then Exit Sub
   If VarType(oDat) >= vbArray Then
      p = UBound(oDat, 2)
      ReDim sDat(1 To p, 1 To 1)
      For i = 1 To p
         sDat(i, 1) = oDat(1, i)
      Next i
      n = 1
      For i = 2 To UBound(oDat, 1)
         For j = 1 To p
            If Not IsEmpty(oDat(i, j)) Then Exit For
         Next j
         If j <= p Then
            n = n + 1
            ReDim Preserve sDat(1 To p, 1 To n)
            For j = 1 To p
               sDat(j, n) = oDat(i, j)
            Next j
         End If
      Next i
   End If
   Range(Cells(1, 1), Cells(1, 1).SpecialCells(xlLastCell)).ClearContents
   Cells(1, 1).Resize(n, p).Value = WorksheetFunction.Transpose(sDat)
End Sub[/B][/COLOR]

Ça a l'air de fonctionner sur 5000 lignes.
Mais je n'ai pas testé sur 55000 lignes...

ROGER2327
#3892

Hunyadi 29 Gidouille 137 (hunyadi gras - Nom d'Ubu, SS)
25 Messidor An CCXVIII
2010-W28-2T23:59:42Z

smotty · 14 Juillet 2010

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

Bonjour à tous,

voir mon prochain message, trop d'erreurs dans ce code, je le supprime

Merci à Roger2327 d'avoir vu mes erreurs

cdt

smotty

c'est un peu hard mais il n'y a pas de boucles. c'est ce qui ralentit le tout.

ROGER2327 · 14 Juillet 2010

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

Bonjour smotty

smotty à dit:
(...)
c'est un peu hard mais il n'y a pas de boucles. c'est ce qui ralentit le tout.

Idée intéressante que de supprimer les boucles pour gagner du temps. Pouvez-vous m'indiquez ce que vous gagnez en temps, car je n'ai pas réussi à faire fonctionner votre procédure ?
Je ne peux donc pas me rendre compte de l'amélioration que vous obtenez.
Merci d'avance.

ROGER2327
#3894

Dimanche 1er Tatane 137 (Fête du Père Ubu (Ubu d'été), SPs)
26 Messidor An CCXVIII
2010-W28-3T08:20:57Z

smotty · 14 Juillet 2010

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

Bonjour Roger2327

Je viens de voir des erreurs dues à le retranscription rapide sur le fil:

Code:

Sub SupprimeVides()
    Dim C As Range
    Dim l As Long
    
    Application.ScreenUpdating = False
    l = [A65535].End(xlUp).Row
    
    Range("O1:O" & l).FormulaR1C1 = "=COUNTA(RC[-14]:RC[-1])"
    
    Range("O1:O" & l).Copy
    Range("P1").PasteSpecial Paste:=xlPasteValues
    Range("P1:P" & l).Copy Range("O1")
    Range("P1:P" & l).Clear
    Application.CutCopyMode = False
    
    
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("O1:O" & l) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("A1:O" & l)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
    'cherche le premier zero et delete toutes les lignes suivantes
    Set C = Range("O:O").Find(0)
    Rows(C.Row & ":" & l).Delete
    
    Columns("O:O").Clear
    Application.ScreenUpdating = True

End Sub

Testé sur 55000 lignes en moins de 2 secondes.

penser à enlever les msgbox de repères qui sont dans le code du fichier.

A+

smotty

ROGER2327 · 14 Juillet 2010

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

Re...

Merci pour ce classeur. Je ne peux malheureusement pas l'essayer car j'obtiens la réponse suivante :

ROGER2327
#3896

Dimanche 1er Tatane 137 (Fête du Père Ubu (Ubu d'été), SPs)
26 Messidor An CCXVIII
2010-W28-3T17:44:28Z

Kargos · 14 Juillet 2010

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

Merci beaucoup à tous!

Après avoir essayé toutes vos solutions, j'en conclus que la plus rapide est la 2e proposée par smotty (environ 2 secondes). Par contre, l'ordre original dans lequel sont placées mes données est important, je ne peux donc pas l'utiliser.

Toutefois, la solution proposée par Roger2327 s'exécute en 4 secondes sur 55 000 lignes, elle me satisfait donc amplement bien que je ne comprenne pas en quoi consiste les "special Cells". En fait, j'ai copié/collé le code tel quel, mais je dois admettre que je n'y comprends rien

...

Merci à tous les autres également

ROGER2327 · 14 Juillet 2010

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

Re...

Kargos à dit:
Merci beaucoup à tous!

Après avoir essayé toutes vos solutions, j'en conclus que la plus rapide est la 2e proposée par smotty (environ 2 secondes). Par contre, l'ordre original dans lequel sont placées mes données est important, je ne peux donc pas l'utiliser.

Toutefois, la solution proposée par Roger2327 s'exécute en 4 secondes sur 55 000 lignes, elle me satisfait donc amplement bien que je ne comprenne pas en quoi consiste les "special Cells". En fait, j'ai copié/collé le code tel quel, mais je dois admettre que je n'y comprends rien ...

Merci à tous les autres également

Quelques éclaircissements sur le code :
Plutôt que de travailler directement sur la feuille de calcul, je travaille sur des variables. Avec la ligne

Code:

[COLOR="DarkSlateGray"][B]oDat = Range(Cells(1, 1), Cells(1, 1).SpecialCells(xlLastCell)).Value
[/B][/COLOR]

je place toutes les données de la feuille, de la cellule A1 (ou Cells(1, 1)) à la dernière cellule, obtenue par Cells(1, 1).SpecialCells(xlLastCell), dans la variable oDat.
Je vais ensuite lire les données de chaque ligne, et, si les données ne sont pas toutes vides, je recopie l'ensemble de la ligne dans un autre tableau sDat.
J'efface ensuite les données dans la feuille, et j'y dépose les valeurs conservées dans le tableau sDat.
Voilà...

ROGER2327
#3898

Dimanche 1er Tatane 137 (Fête du Père Ubu (Ubu d'été), SPs)
26 Messidor An CCXVIII
2010-W28-3T19:33:24Z

laetitia90 · 14 Juillet 2010

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

bonsoir tous une variante en combinant formule & tablo
dans le cas de kargos suppose les colonnes vides a partir de colonne p

Code:

Sub es()
Dim t As Variant, t2() As String, x As Long, i As Long, k As Long
 Application.ScreenUpdating = False
 Range("P1").Select
 ActiveCell.FormulaR1C1 = "=COUNTA(RC[-15]:RC[-1])"
 Range("p1:p" & Cells.Find("*", , , , , xlPrevious).Row).FillDown
On Error Resume Next
t = Range("a1:p" & Cells(Rows.Count, 1).End(xlUp).Row)
x = 1
For i = 1 To UBound(t)
If t(i, 16) <> 0 Then
ReDim Preserve t2(1 To 15, 1 To x)
For k = 1 To 15
t2(k, x) = t(i, k): Next k: x = x + 1: End If: Next i
Columns("A:P").ClearContents
Range("a1").Resize(UBound(t2, 2), UBound(t2, 1)) = Application.Transpose(t2)
Erase t, t2
End Sub

Kargos · 14 Juillet 2010

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

Wow. Merci beaucoup Roger!

smotty · 14 Juillet 2010

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

Bonsoir,

Je pense que c'est un peu tard mais au cas où la solution intéresserait quelqu'un, voici le code pour conserver l'ordre des données. J'utilise le filtre au lieu du tri:

Code:

Sub SupprimeVides()
    Dim C As Range
    Dim l As Long
    
    'Application.ScreenUpdating = False
    l = [A65535].End(xlUp).Row
    
    Range("O1:O" & l).FormulaR1C1 = "=COUNTA(RC[-14]:RC[-1])"
    
    Range("O1:O" & l).Copy
    Range("P1").PasteSpecial Paste:=xlPasteValues
    Range("P1:P" & l).Copy Range("O1")
    Range("P1:P" & l).Clear
    Application.CutCopyMode = False
    
    ActiveSheet.Range("$A$1:$O$" & l).AutoFilter Field:=15, Criteria1:="0"
    
    Set C = Range("O:O").Find(0)
    l = [O65535].End(xlUp).Row
    
    Rows(C.Row & ":" & l).Delete
    
    Selection.AutoFilter
    Columns("O:O").Clear
    
    Application.ScreenUpdating = True

End Sub

ROGER2327, ta solution m'interpelle particulièrement car je ne connaissais pas cette méthode, je vais l'étudier plus précisément

Par contre je ne comprends pas pourquoi tu as un bug sur le classeur envoyé précédemment.

Peut-être que sous cette forme??

cdt

smotty

ROGER2327 · 15 Juillet 2010

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

Re...

Merci pour cette nouvelle version. Elle fonctionne chez moi s'il y a au moins une ligne vide. Sinon, j'obtiens un blocage sur cette ligne de code :

Code:

[COLOR="DarkSlateGray"][B]    Rows(C.Row & ":" & l).Delete[/B][/COLOR]

Par contre, la première version ne passe vraiment pas. Est-elle faite pour Excel2003 ou pour une autre version ?

ROGER2327
#3901

Dimanche 1er Tatane 137 (Fête du Père Ubu (Ubu d'été), SPs)
26 Messidor An CCXVIII
2010-W28-3T22:22:11Z

Effectuez une recherche sur Excel Downloads...

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

Kargos

XLDnaute Nouveau

Habitude

XLDnaute Accro

JNP

XLDnaute Barbatruc

smotty

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

smotty

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

smotty

XLDnaute Occasionnel

Pièces jointes

ROGER2327

XLDnaute Barbatruc

Pièces jointes

Kargos

XLDnaute Nouveau

ROGER2327

XLDnaute Barbatruc

laetitia90

XLDnaute Barbatruc

Kargos

XLDnaute Nouveau

smotty

XLDnaute Occasionnel

Pièces jointes

ROGER2327

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums