Optimisation VBA -Suppression de lignes selon une contrainte

Question

Premièrement je vous remercie pour le temps que vous allez prendre à lire et essayer de résoudre mon problème. Je débute un peu en VBA et j'aurais besoin de vos conseil pour optimiser mon code. (Il fait partie d'un plus grand ensemble) j'ai effectué pas mal de recherche sans trop trouver J'utilise actuellement le code suivant : sub suppressionligne() ' Etape 1.3 supprimer les lignes où il y a écrit doublon en colonne R Dim r As Integer With ThisWorkbook.Sheets("Original") ' le travail est sur la feuille Original (ne pas enlever ceci) For r = .Range("R" &amp; .Rows.Count).End(xlUp).Row To 2 Step -1 ' La recherche se fait sur la colonne R ' Rows.count permet de donner le nombre de ligne de la plage range mais thisworkbook.sheets doit être appelé avant If .Range("R" &amp; r).Value = "Doublon" Then .Rows(r).Delete ' Si la valeur en ligne de la colonne R est "Doublon" alors il supprime la ligne ' La valeur à supprimer = Doublon End If Next r ' Prochaine ligne End With End sub Le code fonctionne mais il est vraiment long. j'ai cru comprendre qu'il me fallait utiliser une plage en variant pour le rendre vraiment plus rapide ! Un début de code serait celui-ci dessus mais je n'arrive pas à imbriquer l'ancien et le nouveau.. Dim rangecell As Range Dim vari as Variant dercell = Range("R65536").End(xlUp).Row Set rangecell = Worksheets("MaFeuille").Range("R1:R" &amp; dercell") ' vari = rangecell ' je dois rentrer mon code pour supprimer ... rangecell = vari Pourriez-vous me donner un coup de main ? Il faut savoir que j'ai déjà activé Application.ScreenUpdating = False en amont de mon code ! Merci ...

eriiic · Accepted Answer

Re,

et un autre basé sur ma proposition, en supposant qu'il n'y a pas de filtre auto au départ :

[A1].AutoFilter
[A1].AutoFilter Field:=18, Criteria1:="doublon"
[A2].Resize(Cells(Rows.Count, "A").End(xlUp).Row - 1).EntireRow.Delete
[A1].AutoFilter

eric

eriiic · Answer

Le code fonctionne mais il est vraiment long. j'ai cru comprendre qu'il me fallait utiliser une plage en variant pour le rendre vraiment plus rapide ! Plage dynamique tu veux dire je pense ? C'est déjà le cas puisque tu limites aux lignes utilisées. Il faut savoir que j'ai déjà activé Application.ScreenUpdating = False Dans cette même procédure ? Sinon il est réactivé sur un End Sub. Le plus rapide : mettre un filtre automatique, filtrer et supprimer les lignes visibles en une fois. eric...

Jean-Eric · Answer

Essaie ceci : Option Explicit Public Sub suppressionligne() Dim ws As Worksheet, _ derLigne As Long, i As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("Original") With ws derLigne = .Range("R" &amp; Rows.Count).End(xlUp).Row For i = derLigne To 2 Step -1 If .Cells(i, "R") = "Doublon" Then .Rows(i).Delete Next i End With Set ws = Nothing End Sub...

Jean-Eric · Answer

Re, Quel est le nombre de lignes à traiter, pour un temps d'exécution de 7 minutes...

Jean-Eric · Answer

Re,

Je ne comprends pas ce temps de 7 minutes pour 3123 lignes !

Essaie cette nouvelle proposition avec une fonction personnalisée pour accélérer le code.

A te relire.

Public Sub suppressionligne()
Dim ws As Worksheet, _
    derLigne As Long, i As Long

    FastRun (False)
    Set ws = ThisWorkbook.Worksheets("Original")

    With ws
        derLigne = .Range("R" & Rows.Count).End(xlUp).Row
        For i = derLigne To 2 Step -1
            If .Cells(i, "R") = "Doublon" Then .Rows(i).Delete
        Next i
    End With

    FastRun = True

    Set ws = Nothing

End Sub

Public Function FastRun(Setting)
    With Application
        '.StatusBar = "Mise à jour des paramètres d'Excel. Veuillez patienter..."
        .EnableCancelKey = xlDisabled
        .ScreenUpdating = Setting
        .DisplayAlerts = Setting
        .Interactive = Setting
        '.EnableFormatConditionsCalculation = Setting
        .EnableEvents = Setting
    End With
    If Setting = False Then Application.Calculation = xlCalculationManual
    If Setting = False Then Application.Cursor = xlWait
    If Setting = True Then Application.Calculation = xlCalculationAutomatic
    If Setting = True Then Application.Cursor = xlDefault
    'Application.StatusBar = False
End Function