Gagner en vitesse d'exécution - Tableau

Bonjour à tous.

Voici mon problème, ou plutôt ma demande de conseils.

J'ai mis au point une macro qui me permet de faire le tri des lignes que je souhaite garder dans un tableau que j'importe.

Le problème est que ce tableau possède parfois plus de 100 000 lignes et l'exécution met plus de 20 minutes.

Vous avez une idée pour gagner en vitesse?

Merci à vous.

Voici le code:

Sub test2()

Application.ScreenUpdating = False

Dim i As Long

Dim col_A As Range

Dim col_B As Range

Dim col_C As Range

Dim col_IMOA As Range

Dim cel As Variant

Dim derlignH As Variant

'Definition plage de cellules en memoire pour vitesse execution

Set col_A = Worksheets("BdD").Range("A:A")

Set col_B = Worksheets("BdD").Range("B:B")

Set col_C = Worksheets("BdD").Range("C:C")

Set col_IMOA = Worksheets("feuil4").Range("F:F")

derlignH = Range("H" & Rows.Count).End(xlUp).Row

With ThisWorkbook.Sheets("Feuil1")

For i = derlignH To 1 Step -1

'Garde les lignes suivants conditions suivantes:

'Feuil4 colonne F = 1 ou

'Feuil BdD colonne A = 1 ou

'Feuil BdD colonne B ET colonne C = 1

If (Application.CountIf(col_IMOA, .Range("B" & i).Value) = 1) _

Or (Application.CountIf(col_A, .Range("A" & i).Value) = 1) _

Or ((Application.CountIf(col_B, .Range("B" & i).Value) = 1) _

And (Application.CountIf(col_C, .Range("C" & i).Value) = 1)) Then

i = i

Else

Range("A" & i).EntireRow.Delete

End If

Next i

End With

'supprimer les valeurs dans cellule B et C lorsque A est renseignée.

For Each cel In Range("A:A")

If cel.Value <> "" Or cel.Value <> 0 Then

cel.Offset(0, 1).Value = ""

cel.Offset(0, 2).Value = ""

End If

Next cel

Application.ScreenUpdating = True

End Sub

Hello,

Ton fichier exemple n'en comporte pas, mais ton fichier d'origine à t'il des formules de calculs ? Si oui, désactive le calcul automatique, regarde le forum Astuce > Topic : Accélération de code.

Non non mon fichier ne comporte pas de formules.

Sinon effectivement je serais passé en calcul manuel.

ok je pense que j'ai une solution, mais là je suis crevé, je te tiens au courant demain.

Au départ je pensais que la suppression de ligne était ce qu'il y'avait de plus long mais en fait le plus long c'est ça :

    For Each cel In Range("A:A")
        If cel.Value <> "" Or cel.Value <> 0 Then
        cel.Offset(0, 1).Value = ""
        cel.Offset(0, 2).Value = ""
        End If
    Next cel

Très certainement due au fait qu'il parcourt toute la colonne, ce qui fait près d'1 million d'occurence, en limitant la zone de traitement ça peux le faire, par sécurité, étant donné que tu va jusqu'à 100 000, il faudrait importer les données des colonnes A,B,C dans un tableau numérique multidimensionnel > modifier directement dans ce tableau > puis dispatcher les valeurs du tableau numérique dans le tableau Excel.

Je l'ai fais pour un tableau à 1 colonne, il ne devrait pas y avoir trop de problème pour un tableau à 3 colonnes.

Y'a un cours sur ce lien qui en parle d'ailleurs :

https://www.excel-pratique.com/fr/vba/tableaux_vba.php

a+

Ok super merci mais j'ai vraiment l'impression que c'est la suppression de ligne qui prend le plus de temps.

Au pire je peux remplacer le for each cel par un for i = dernièreligne to 1 step -1 puis un IF value= "" ou 0 .Ce n'est pas le plus compliqué à adapter je pense.

Les 20 minutes sont vraiment le temps qu'il faut pour supprimer les lignes (quand je mets screenupdating=true je ne te raconte même pas le temps que ça prend

Merci en tout cas pour ton aide.

Peut être qu'au lieu de supprimer tout de suite, utiliser la colonne i de ton fichier, à chaque fois qu'il faut supprimer la ligne, à la place on mets une valeur 1 dans la cellule ligne de la colonne i, à la fin, on fait un filtre ou un tri de colonne i, on selectionne toutes les lignes de la colonne i qui possède la valeur 1 et suppression des lignes sélectionnées.

Peut être que supprimer plusieurs lignes d'un coup, ira plus vite que d'y aller une à une.

Tout ça par VBA bien sûr

Bonsoir,

en poursuivant l'idée de mettre un 1 o u rien en fonction de la futur suppression et en utilisant la fonction :

SpecialCells(xlCellTypeBlanks).EntireRow.delete

dans le style :

Range("I1:I" & dernière_ligne).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden

@ bientôt

LouReeD

Je vous remercie je vais essayer ça dans la journée je vous tiens au courant

Hi,

Voilà déjà un premier jet avec la bonne idée de Loureed, ça va plus vite, pour 8000 lignes il met 10 secondes chez moi, de mon côté c'est le process de fin de 'supprimer les valeurs dans cellule B et C lorsque A est renseignée.' qui me prend le plus de temps (au moins les 2/3 du temps à vue d'oeil), tout à l'heure je te propose un tableau numérique.

Pour l'instant je pense que tu passe pour 100K lignes de 20min à ~2/3 grosses minutes.

+

Code :

Sub test2()
'1. déclaration des variable temps comme date de prise en compte
'Dim FIN1 As Date
'Dim FIN2 As Date
'Dim début1 As Date
'Dim début2 As Date
'2. Placer le compteur temps de début à l'emplacement de la procédure que l'on souhaite chronométrer
'début1 = Timer

Application.ScreenUpdating = False
Windows.Application.Visible = False '<<<<<<<<<<<< Pour désafichage de l'application, pour éviter erreur d'appel application
On Error Resume Next '<<<<<<<<<<<< Gestion erreur, Si erreur passe

Dim i As Long
Dim col_A As Range
Dim col_B As Range
Dim col_C As Range
Dim col_IMOA As Range
Dim cel As Variant
Dim derlignH As Double

'Definition plage de cellules en memoire pour vitesse execution
Set col_A = Worksheets("BdD").Range("A:A")
Set col_B = Worksheets("BdD").Range("B:B")
Set col_C = Worksheets("BdD").Range("C:C")
Set col_IMOA = Worksheets("feuil4").Range("F:F")
derlignH = Range("H" & Rows.Count).End(xlUp).Row

  With ThisWorkbook.Sheets("Feuil1")
    For i = derlignH To 2 Step -1 'to 2 pour inclure barre titre
      'Garde les lignes suivants conditions suivantes:
      'Feuil4 colonne F = 1 ou
      'Feuil BdD colonne A = 1 ou
      'Feuil BdD colonne B ET colonne C = 1
      If (Application.CountIf(col_IMOA, .Range("B" & i).Value) = 1) _
            Or (Application.CountIf(col_A, .Range("A" & i).Value) = 1) _
                Or ((Application.CountIf(col_B, .Range("B" & i).Value) = 1) _
                And (Application.CountIf(col_C, .Range("C" & i).Value) = 1)) Then
                i = i
        Else
        Range("I" & i).EntireRow.Clear '<<<<<<<<<<<<<<<<<<<<<<<<< suppression valeur ligne pour tri valeur après
      End If
    Next i
  End With
  'Tri lignes tableau par valeur, suivant colonne H
    ThisWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ThisWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("H2:H" & derlignH) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ThisWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("A1:H" & derlignH)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

  'FIN1 = Timer
  'début2 = Timer

  'supprimer les valeurs dans cellule B et C lorsque A est renseignée.
 derlignH = Range("H" & Rows.Count).End(xlUp).Row 'Redéfinition dernière ligne
 'Le filtre du dessus à déjà répondu à la question SI A pas vide, rien, ne reste que A plein B/C vide, donc reste à supprimer les valeur en B/C
 'Range("B2", "C" & derlignH).ClearContents

   For Each cel In Range("A2", "A" & derlignH) 'Limite du parcours de la boucle, pour éviter un traitement sur toute la colonne
       If cel.Value <> "" Or cel.Value <> 0 Then
        cel.Offset(0, 1).Value = ""
        cel.Offset(0, 2).Value = ""
        End If
    Next cel

'FIN2 = Timer

Windows.Application.Visible = True '<<<<<<<<<<<< faire réapparaitre l'application et la fait clignotée dans sa barre
Application.ScreenUpdating = True
'4. Message chronomètre avec le temps parcouru
'MsgBox "temps supp ligne = " & FIN1 - début1 & Chr(10) & "temps supp valeur colonne = " & FIN2 - début2 'Format(timeR - temp, "SS")
End Sub

Edit : Suppression bug et optimisation

Edit,

J'ai vus qu'il y'avait des bugs dans mon 1er jet, j'ai édité un nouveau code optimisé, en ne passant pas par la suppression de ligne, mais la suppression valeur et tri valeur, tu gagne bien 30% de gain de temps par rapport à avant pour ce seul process.

Reste ton 2e process de suppression valeur colonne B/C suivant A, qui prend la moitié du temps, je pensais passer par le tableau numérique, mais le créer puis redispatcher les valeurs dans Excel, ne sert en fait à rien, ça rallonge en fait,

Pas d'idée, pour faire mieux, peut être qu'à la place de "Definition plage de cellules" , on crée un tableau numérique, on fait le calcul IF > Puis suppression ligne > suppression valeur et redispatching dans Excel, ça pourrait le faire.

Par contre je n'ai pas compris l'intérêt de la formule IF, à part le fait qu'elle repère les valeurs vides dans la colonne A ce qui lui permet de supprimer la ligne correspondante.

Si le code comme ça te convient, ou que t'a trouvé mieux, on passe, sinon dit moi à quoi sert la formule IF et on test un tableau numérique complet géré dès le départ, histoire de voir si ça va plus vite.

+

bonjour

je me permets d'intervenir malgré mon manque d'expérience dans les gros fichiers, car bientôt j'en aurai aussi à traiter

de mon côté, au lieu de supprimer des lignes, j'ai testé un "filtre avancé" sur 100 000 lignes, c'est très rapide ( 1 seconde )

pas de boucle avec VBA

il ne reste plus qu'à supprimer les colonnes d'origine pour ne retenir que la zone de collage (1 seconde également)

ça doit pouvoir se mettre en VBA

C'est super merci.

En fait je suis passé par la méthode du filtrage.

J'ai mis toutes les colonnes A à "1" au lieu de supprimer les lignes puis j'ai fait un filtre avec les valeurs 1 et j'ai fini en supprimant ces colonnes puis en réaffichant les autres. Je pensais que ça serait plus long que de supprimer directement la ligne mais non.

J'ai le résultat en 2 minutes pour 65 000 lignes.

Ca me convient largement.

Merci à tous pour les conseils.

Cool 8) , de mon côté j'ai supprimé ta boucle For Each cel, en utilisant le filtre et la suppression de valeur des colonnes B/C, ça me divise le temps par 10 sur cette procédure.

Bon boulot tout le Monde

Bye

J'ai malheureusement besoin de "vider" les cellules B et C pour pouvoir les reremplir correctement par la suite avec une autre macro, pas de mon niveau cette fois ci

Sujet résolu.

Merci à tous

Rechercher des sujets similaires à "gagner vitesse execution tableau"