Discussion :

[MarcelG]

Bonjour le Forum,

Un modeste astuce.

Pour supprimer les lignes d'une feuille de calcul, s' l'une d'elle contient un mot dans une cellule, il est habituel de
- considérer la dernière ligne
- tester le mot
- supprimer la ligne
- boucler jusqu'à la première ligne en utilisant un pas négatif de -1.

Récemment, pour connaître la dernière cellule vide d'une plage, l'ami Patrick m'a suggéré, judicieusement, l'argument Previous sur les cellules - spéciales - vides.

Dès lors, je me suis demandé comment appliquer ce processus au test décrit ci-dessus.
Réponse: Méthode

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

FindPrevious

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Public Sub testfindprev()
 
Dim derlign As Long
Dim c As Range
Dim ladress As String
 
With Worksheets("testprev")
        derlign = .Cells(.Rows.Count, 1).End(xlUp).Row
        With .Range("  A1:A" & derlign)
        Set c = .Find(What:="tata", LookIn:=xlValues, SearchDirection:=xlPrevious)
            If Not c Is Nothing Then
                Do
                    ladress = c.Address
                    c.EntireRow.Delete
                    Set c = .FindPrevious(After:=.Range(ladress))
                Loop While Not c Is Nothing
            End If
        End With
        Set c = Nothing
End With
 
End Sub

Nous remarquons ici que l'enregistrement de l'adresse de la ligne à supprimer est obligatoire.

En effet, coder

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
c.EntireRow.Delete
Set c = .FindPrevious(After:=c)

implique une erreur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1004: Impossible de lire la propriété FindPrevious de la classe Range

Ce qui est logique du fait de la suppression de la ligne.

Par avance, je vous remercie pour vos remarques et commentaires.

En vous souhaitant une agréable journée.

Marcel

[unparia]

Bonjour Marcel
Ne crois-tu pas plus astucieux (et simple et rapide) d'utiliser Find et Findnext pour constituer une plage (avec la méthode Union), puis
(si P est cette variable range et P n'est pas Nothing) --->>

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

P.entirerow.delete

?

[MarcelG]

Bonjour Unparia,

Bien noté.
A vrai dire, je n'y avais pas pensé.
J'avais en tête cette notion de Previous et le souci, constant même si je parfois cède à la facilité, d'éviter les balayages.
En règle générale, je préfère utiliser la méthode Find
Cela dit,

plus simple

Il s'agit dans les 2 cas de la combinaison de 2 méthodes Find/FindPrevius et Find/FindNext. Non?

plus rapide

.Je pense qu'il faut tester.
A priori, ce me semble possible, du fait que les lignes sont supprimées en une seule action.

En toute simplicité, mon post aura au moins cet avantage de mettre en exergue ces deux solutions alternatives.

Merci!

[MarcelG]

Bonsoir,

J'ai voulu tester les performances des différents codes en terme de temps d'exécution.

L'alimentation de ma feuille de travail a été réalisée - trivialement - par ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Option Explicit
 
Public Sub alim_rng()
 
Dim i As Long
 
For i = 1 To 30000 Step 5
        With Worksheets("testprev").Cells(i, 1)
                .Value = .Row
        End With
Next i
 
For i = 1 To 30000
        With Worksheets("testprev").Cells(i, 1)
                If .Value = "" Then .Value = "tata"
        End With
Next i
 
End Sub

LA méthode "classique" et la méthode "Marcel" ont eu un temps d'exécution similaire : 12 secondes.
J'en ai été étonné.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Public Sub test_classique()
 
Dim derlign As Long, i As Long, n As Long
 
Dim t As Single
t = Timer
 
Application.ScreenUpdating = False
 
n = 0
With Worksheets("testprev")
        derlign = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = derlign To 1 Step -1
                With .Cells(i, 1)
                        If .Value = "tata" Then
                                n = n + 1
                                .EntireRow.Delete
                        End If
                End With
        Next i
End With
 
Debug.Print "Méthode classsique pour " & n & " lignes: " & Timer - t & "secondes"
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Public Sub testfindprev_marcel()
 
Dim derlign As Long
Dim c As Range
Dim ladress As String
 
Dim t As Single
Dim n As Long
t = Timer
 
Application.ScreenUpdating = False
 
n = 0
With Worksheets("testprev")
        derlign = .Cells(.Rows.Count, 1).End(xlUp).Row
        With .Range("A1:A" & derlign)
        Set c = .Find(What:="tata", LookIn:=xlValues, SearchDirection:=xlPrevious)
            If Not c Is Nothing Then
                Do
                    n = n + 1
                    ladress = c.Address
                    c.EntireRow.Delete
                    Set c = .FindPrevious(After:=.Range(ladress))
                Loop While Not c Is Nothing
            End If
        End With
        Set c = Nothing
End With
 
Debug.Print n & " \ " & Timer - t
 
End Sub

Pour la méthode Unparia, le code a généré une erreur

91 Variable Objet du bloc With non définie

sur la méthode Loop.
c est alors Nothing.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Public Sub testfindprev_unparia()
 
Dim derlign As Long
Dim c As Range
Dim firstaddress As String
Dim P As Range
 
Dim t As Single
t = Timer
 
Application.ScreenUpdating = False
 
With Worksheets("testprev")
        derlign = .Cells(.Rows.Count, 1).End(xlUp).Row
        With .Range("A1:A" & derlign)
                Set c = .Find("tata", LookIn:=xlValues)
                If Not c Is Nothing Then
                        firstaddress = c.Address
                        Set P = c
                        Do
                                Set P = Union(P, c)
                                Set c = .FindNext(c)
                        Loop While Not c Is Nothing And c.Address <> firstaddress
                End If
                Set c = Nothing
        End With
End With
 
If Not P Is Nothing Then P.EntireRow.Delete
 
Debug.Print "Méthode Unparia" & P.Count & " \ " & Timer - t
 
Set P = Nothing
 
End Sub

Dans la fenêtre Exécution, j'ai interrogé le nombre d'éléments du Range P alors atteint.
Résultat: 14255
Je ne vois pas pourquoi

[unparia]

Pour la méthode Unparia, le code a généré une erreur

Ce n'est pas la méthode, qui a généré ton erreur, mais ta manière de l'utiliser.
Voici (exemple) comment procéder :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 Dim quoi As String, c As Range, p As Range, adr As String
  quoi = "toto" ' ce que l'on recherche
  Set c = ActiveSheet.Range("A:A").Find(what:=quoi)
  Set p = c
    If Not c Is Nothing Then
        adr = c.Address
        Do
            Set c = ActiveSheet.Range("A:A").FindNext(after:=c)
            If Not c Is Nothing Then Set p = Union(p, c)
        Loop Until c Is Nothing Or c.Address = adr
    End If
    MsgBox p.Address
    p.EntireRow.Delete

[MarcelG]

Ce n'est pas la méthode, qui a généré ton erreur, mais ta manière de l'utiliser

C'est ce que je sous-entendais, bien sûr.

Quoi qu'il en soit, merci pour ce retour

[MarcelG]

J'ai voulu constater le temps d'exécution.

Ma feuille étant alimentée comme indiqué, l'exécution génère le même message d'erreur (91 - ...)
sur la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Loop Until c Is Nothing Or c.Address = adr

Au moment où cette erreur survient, la proprité p.Count me retourne 11514.
Ce alors que 26000 lignes seraient à supprimer.

Je ne comprends pas la raison de cette anomalie.

Voici le code proposé par Unparia adapté.
Je ne pense pas y avoir apporté une modification fondamentale.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Public Sub testfindprev_unparia()
 
Dim T As Single
T = Timer
 
Dim derlign As Long
Dim champ As Range
 
Dim quoi As String, c As Range, p As Range, adr As String
quoi = "tata" ' ce que l'on recherche
 
With Worksheets("testprev")
        derlign = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set champ = .Range("A1:A" & derlign)
        Set c = champ.Find(what:=quoi)
        Set p = c
        If Not c Is Nothing Then
                adr = c.Address
                Do
                Set c = champ.FindNext(after:=c)
                If Not c Is Nothing Then _
                        Set p = Union(p, c)
                Loop Until c Is Nothing Or c.Address = adr
        End If
        Set c = Nothing
        Set champ = Nothing
End With
 
If Not p Is Nothing Then
        Debug.Print p.Address
        p.EntireRow.Delete
End If
 
Debug.Print "Méthode Unparia" & p.Count & " \ " & Timer - T & "secondes."
 
Set p = Nothing
 
End Sub

[halaster08]

Bonjour,

Pour info: pas d'erreur chez moi avec ta version modifiée du code d'unparia

edit: cependant il me semble plus simple d'utiliser un filtre que d'enchainer les find

[MarcelG]

Salut Halaster,

Merci pour ton concours.

J'ai testé avec 10000 enregistrements.
Bonne exécution du code.
Cela reviendrait-t-il donc ce que le nombre d'enregistrements est limité pour ce genre de code?

Nota pour Unparia,

En considérant la 1ère version du code que j'ai rédigée sur tes indications, celui-ci était bien effectif. Avec 10000 lignes.
Ce ne serait donc pas ma

manière de l'utiliser

qui était en cause mais plutôt le nombre d'enregistrements (de lignes).

Par prudence, je m'exprime au conditionnel.

P.S. Version d'Excel 2016

Merci.

[unparia]

Ce n'est pas la méthode Find, qui est déficiente en ce qui concerne cet aspect-là, mais la méthode Union, dont le nombre de plages à unir est limité.

On traite alors dans un tel cas (au demeurant exceptionnel) par "paquets".
Il me semble me rappeler que j'ai déjà eu l'occasion de montrer cela.

[MarcelG]

D'accord.
Merci pour cette précision.
Si tu retrouves le post au sein duquel tu es intervenu sur cette limite, alors je suis preneur.

[halaster08]

Pas sur que ce soit le nombre de lignes j'ai essayé avec 99.999 lignes soit largement plus que ~11.000 qui t'avais posé soucis (Excel 2010 chez moi)

edit: le temps de répondre a un collègue j'ai déjà deux messages de retard
Merci unparia pour la précision

[MarcelG]

Merci.
Les conclusions d'Unparia et moi-même se rejoignent (limite de la méthode Union).
Alors quoi? Version d'Excel?
Si un élément de réponse peut être apporté, il serait apprécié.

[halaster08]

Attention, unparia a précisé limite du nombre de plages pas du nombre de lignes de la méthode union, j'avais testé sur 99.999 lignes mais en quelques plages seulement c'est pour ça que je n'ai pas eu d'erreur.

[unparia]

Si tu retrouves le post au sein duquel tu es intervenu sur cette limite, alors je suis preneur.

je ne parviens pas à le retrouvern mais peu importe. C'est très simple --->>
soit n (disons par exemple 500) le nombre de plages voulues par paquet --->> il suffit de transformer ainsi la boucle do du code --->>

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Do
            Set c = ActiveSheet.Range("A:A").FindNext(after:=c)
            If Not c Is Nothing Then Set p = Union(p, c)
            If p.Areas.Count > N Then  ' si p contient plus de plages discontinues que N
                MsgBox p.Address: Set p = c
                'p.EntireRow.Delete
            End If
Loop Until c Is Nothing Or c.Address = adr

[RyuAutodidacte]

Bonjour à tous,

Une autre méthode consiste à supprimer en une fois les lignes voulues …
On peut utiliser delete, mais aussi (ou) clear permettant d’accélérer le processus ainsi qu’avec l’utilisation de screenupdating.
Pour cela utilisation d’une formule et d’un tri bien sur le tout à adapter … ( le tout sans boucle )
C’est ici : https://www.developpez.net/forums/d1...e/#post9205474

[unparia]

Salut Ryu (et merci au passage)
Il est également possible de :
- le faire sans aucune boucle ni filtre si la plage "totale" n'est pas trop fractionnée en "areas", du fait que (en lisant le message initial) on recherche sans "xlpart"
- le faire avec une boucle extrêmement réduite si la plage "totale" est trop fractionnée en "areas"
Le distinguo entre les deux sera alors tout simplement le comportement de la propriété specialcells, limitée par le nombre maximum de plages(areas) discontinues.

Il en va bien entendu différemment si l'on traite en "xlpart"

Amitiés

[RyuAutodidacte]

Re Jacques (de rien, c'est un juste retour des astuces que tu as pu me faire découvrir),

Je ne suis pas sur (ou ne connait pas) la méthode que indique ci-dessus, mais je me suis lancé à entrevoir un autre code,
en essayant de respecter la 1ère partie de ce que tu proposes (exemple avec le A à supprimer - comme dans le lien que j'ai donné):

A	TITI1
B	TITI2
B	TITI3
A	TITI4
A	TITI5
B	TITI6
A	TITI7
G	TITI8
S	TITI9
H	TITI10
A	TITI11
F	TITI12
A	TITI13
H	TITI14
A	TITI15
	TITI16
D	TITI17
	TITI18
A	TITI19

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Demo2()
Dim DL As Long
 
    DL = Cells(Rows.Count, 1).End(xlUp).Row
    With Cells(1).CurrentRegion.Resize(DL)
        With .Columns(.Columns.Count + 1)
    Application.ScreenUpdating = False
            .FormulaLocal = "=SI($A1 = ""A"";1;"""")"
            .Formula = .Value
            .SpecialCells(xlCellTypeConstants).EntireRow.Delete
    Application.ScreenUpdating = True
        End With
    End With
End Sub

[unparia]

Salut, Ryu
Il s"agit là de presque ce à quoi je faisais allusion et qui était ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Range("A:A").Replace what:="A", replacement:=""
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

sur colonne sans vides au départ. Si des vides -->> légèrement différent (les recenser d'abord).

[MarcelG]

Bonjour Unparia, Ryu,
Bonjour le Forum,

Unparia, Ryu,

Pour 30000 lignes dont 24000 à supprimer
Temps d'exécution sur fenêtre Exécution:

Pour 24000 lignes par la méthode Ryu: 5,695313 secondes.
Pour 24000 lignes par la méthode Unparia 3: 5,867188 secondes.

Soit le temps de traitement des processus initiaux divisé par plus de 2!!

à tous les 2

A toute fin utile, je reporte les codes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Public Sub test_suppr_Ryu()
 
Dim derlign As Long
Dim n As Long
 
Dim t As Single
t = Timer
 
Application.ScreenUpdating = False
 
With Worksheets("testprev")
        derlign = .Cells(.Rows.Count, 1).End(xlUp).Row
        With .Range("B1:B" & derlign)
                .FormulaLocal = "=SI($A1 = ""tata"";1;"""")"
                .Value = .Value
                With .SpecialCells(xlCellTypeConstants)
                        n = .Count
                        .EntireRow.Delete
                End With
        End With
End With
 
Debug.Print "Pour " & n & " lignes par la méthode Ryu: " & Timer - t & " secondes."
 
Application.ScreenUpdating = True
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Public Sub test_suppr_Unparia_3()
 
Dim derlign As Long
Dim n As Long
 
Dim t As Single
t = Timer
 
Application.ScreenUpdating = False
 
With Worksheets("testprev")
        derlign = .Cells(.Rows.Count, 1).End(xlUp).Row
        With .Range("A1:A" & derlign)
                .Replace what:="tata", replacement:=""
                With .SpecialCells(xlCellTypeBlanks)
                        n = .Count
                        .EntireRow.Delete
                End With
        End With
End With
 
Debug.Print "Pour " & n & " lignes par la méthode Unparia 3: " & Timer - t & " secondes."
 
Application.ScreenUpdating = True
 
End Sub