Supprimer un grand nombre de ligne

Bonjour à toutes et tous,

Voilà j'ai fait une macro qui fonctionne très bien mais qui prend énormément de temps à s'exécuter. En effet j'intègre un fichier qui peut faire jusqu'à 300 000 lignes à fin août mais qui peut atteindre les 500 000 lignes en fin d'année je pense.

Sur ce fichier intégré, je souhaite que la ligne dont la cellule en colonne J égale à 0 soit supprimée, sur le fichier importé un grand nombre de ligne présente ce cas de figure, j'ai donc fait le code suivant q mais il prend énormément de temps (1h la dernière fois).

Sub TraitementFichier()

Dim DerniereLigne As Long
Dim i As Long
Dim Cellule As Range

Application.ScreenUpdating = False

DerniereLigne = ThisWorkbook.Sheets("GLOBAL").Cells(Rows.Count, 1).End(xlUp).Row 'Calcul de la dernière ligne de la colonne A

With ThisWorkbook.Sheets("GLOBAL")
    .Activate
    .Range("A2:A" & DerniereLigne).Select

    For Each Cellule In Selection 'Conversion des matricules en nombre
        Cellule.Value = Cellule.Value * 1
    Next Cellule

    .Range("M2:AP" & DerniereLigne).FillDown 'Copie des formules de la colonne M à AM jusqu'à la dernière ligne de l'onglet GLOBAL

    For i = DerniereLigne To 2 Step -1
        If .Range("J" & i).Value = 0 Then 'Si une absence totale égale à 0 alors on supprime la ligne
            .Rows(i).EntireRow.Delete
        End If
        If .Range("G" & i).Value > 12 Then 'Si l'absence totale est supérieure ou égale à 12h alors on remplace par 7h
            .Range("G" & i).Value = 7
        End If
    Next i

    .Columns("F:F").Replace What:="AAQ", Replacement:="ADIV" 'Remplacement de AAQ en colonne F par ADIV
    .Columns("H:H").Replace What:="AAQ", Replacement:="ADIV" 'Remplacement de AAQ en colonne H par ADIV
    .Range("A:L").Columns.AutoFit

End With

Application.ScreenUpdating = True

J'ai donc pensé à faire un tri pour isoler les cellules à 0 avec le code ci-dessous mais j'ai l'impression qu'Excel n'arrive pas à gérer le nombre de ligne à effacer et que du coup il plante

.Range("A1:AP1").Autofilter Fields:=10, Criteria1:="0,00"
.Rows("2:" & DerniereLigne).Delete

Auriez-vous une solution à ce problème ? Peut être en disant à Excel de supprimer 2 000 lignes par 2 000 lignes mais je ne sais pas si cela est possible.

Je vous joins le fichier avec la macro ainsi que le fichier à importer (il n'y a que 28 000 lignes car sinon je ne pouvais le joindre au sujet), merci d'avance pour votre aide.

Bonne journée.

Bonjour

Un exemple avec macro temps 20 secondes pour supprimer les lignes avec 0 en colonne J

bonjour,

une proposition (à tester),

edit : devancé par JOCO7915,

Sub TraitementFichier()

    Dim DerniereLigne As Long
    Dim i As Long
    Dim Cellule As Range

    Application.ScreenUpdating = False

    DerniereLigne = ThisWorkbook.Sheets("GLOBAL").Cells(Rows.Count, 1).End(xlUp).Row 'Calcul de la dernière ligne de la colonne A

    With ThisWorkbook.Sheets("GLOBAL")
        .Activate
        .Range("A1:AP" & DerniereLigne).Sort key1:=.Range("J1"), order1:=xlDescending, Header:=xlYes 'mettre tous les 0 de la colonne J en fin de tableau
        Set re = .Range("J2:J" & DerniereLigne).Find(0, lookat:=xlWhole) 'recherche de la première ligne avec un 0 en colonne J
        If Not re Is Nothing Then
            .Rows(re.Row & ":" & DerniereLigne).Delete 'delete massif de toutes les lignes contenant 0 en colonne j
        End If

        DerniereLigne = ThisWorkbook.Sheets("GLOBAL").Cells(Rows.Count, 1).End(xlUp).Row 'Calcul de la dernière ligne de la colonne A
        ' rendre matricules numériques
        Sheets("Boutons").Range("K1") = 0
        Sheets("Boutons").Range("K1").Copy
        Sheets("GLOBAL").Range("A2:A" & DerniereLigne).PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:=False, Transpose:=False
        Sheets("Boutons").Range("K1").Clear

        .Range("A1:AP" & DerniereLigne).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes 'tri croissant sur matricule

        For i = DerniereLigne To 2 Step -1
            If .Range("G" & i).Value > 12 Then 'Si l'absence totale est supérieure ou égale à 12h alors on remplace par 7h
                .Range("G" & i).Value = 7
            End If
        Next i

        .Range("M2:AP" & DerniereLigne).FillDown 'Copie des formules de la colonne M à AM jusqu'à la dernière ligne de l'onglet GLOBAL
        .Columns("F:F").Replace What:="AAQ", Replacement:="ADIV" 'Remplacement de AAQ en colonne F par ADIV
        .Columns("H:H").Replace What:="AAQ", Replacement:="ADIV" 'Remplacement de AAQ en colonne H par ADIV
        .Range("A:L").Columns.AutoFit

    End With

    Application.ScreenUpdating = True

End Sub

Bonjour Messieurs,

Merci beaucoup pour vos codes respectifs ceux-ci marchent parfaitement bien.
Je préfère le code de h2so4 car il s'intègre directement dans le code de ma macro.

Encore merci pour le temps passé dessus.