Optimisation VBA -Suppression de lignes selon une contrainte
Bonjour à tous,
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" & .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" & 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" & 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 !
Bonjour,
N'ayant toujours pas avancé de mon côté sur ce problème
Merci !
Bonjour,
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
Bonjour,
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" & 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
Re,
Merci de vos réponse,
En essayant le code fourni par Jean-Eric cela fonctionne mais le temps d’exécution reste approximativement le même (~7 minutes)
Celui-ci n'est-il pas presque le même que celui que j'avais déjà?
ou peut-être me suis-je mal exprimé en disant que mon code était 'long', je parlais en temps d’exécution!
Re,
Quel est le nombre de lignes à traiter, pour un temps d'exécution de 7 minutes?
3123 exactement, sur 18 colonnes (mais le nombre de colonnes ne doit pas influer)..
Edit :
Sur les 3123 lignes, 1666 sont à supprimer, pour une durée totale de 6 minutes 31 secondes.
Voilà pourquoi je voudrais bien l'accelérer un peu
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
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
Pour Jean-Eric,
J'ai corrigé une erreur minime
FastRun = True
par
FastRun (True)
car sinon elle ne passait pas.
Après avoir tournée pendant un moment le débogueur me surligne cette ligne
If .Cells(i, "R") = "Doublon" Then .Rows(i).Delete
serait-ce dû au fait que je peux avoir des cellules qui affichent quelque chose d'autre ?
Pour Eriiic,
Il semblerait que la méthode fonctionne en quelques secondes sur un document de sauvergarde en l'intégrant de cette manière:
Sub Suppression()
Range("R3").Select ' en R3 car j'ai un décalage
Selection.AutoFilter
Selection.AutoFilter Field:=18, Criteria1:="Doublon"
Selection.Resize(Cells(Rows.Count, "M").End(xlUp).Row - 1).EntireRow.Delete ' M est la colonne qui est remplie jusqu'au bout
Selection.AutoFilter
End Sub
Je vais faire un test sur le vrai document en intégrant le code dans la macro complète, je reviens vers vous après !
Je viens donc de passer d'un temps d'exécution de toute ma macro de 422,41 secondes à 34,27 !
Comme quoi avec un point de vue externe sur le problème et une méthode simple on peut réaliser de grandes avancées !
En vous remerciant tout les deux pour votre aide !
Un temps d'exécution optimisé de 91,88% ou 12,33 fois plus vite !
Bonne journée,