Simplifier une boucle While Wend

[julien974]

Bonjour le forum,

J'ai un PC super lent et je souhaiterais simplifier cette boucle pour accelerer la chose...

Sub supprlignes()

Range("A2").Select

While ActiveCell.Value <> ""

If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then

ActiveCell.Offset(1, 0).EntireRow.Delete

Else: ActiveCell.Offset(1, 0).Select

End If

Wend



End Sub

Merci beaucoup,

juli3n 974

 

[Staple1600]

Re : Simplifier une boucle While Wend

Re


Merci Pascal

J'aurai du chercher moi-même


Mais je croyais avoir lever un lièvre (lol)

 

[Guest]

Re : Simplifier une boucle While Wend

Pascal, Staple,

Merci, on en apprend tous les jours.

Merci.

@Julien, t'en es où de tes essais?

 

[julien974]

Re : Simplifier une boucle While Wend

Re,

La boucle de Pierrejean à fontionné mais ne fonctionne maintenant plus... Le Next n se met en jaune...

Que faire?

Merci

 

[pierrejean]

Re : Simplifier une boucle While Wend

Re

Salut à tous les amis

un essai a base de collection:

Dim list()
ReDim list(0)
Dim coll As Collection
Set coll = New Collection
Application.ScreenUpdating = False
For n = 2 To Range("A2").End(xlDown).Row
  On Error Resume Next
    coll.Add Range("A" & n), CStr(Range("A" & n))
    If Err.Number <> 0 Then
      list(UBound(list)) = n
      ReDim Preserve list(UBound(list) + 1)
    End If
  On Error GoTo 0
Next n
For n = UBound(list) - 1 To 0 Step -1
 Rows(list(n)).Delete
Next n
Application.ScreenUpdating = True

 

[julien974]

Re : Simplifier une boucle While Wend

Parfait Pierrejean!

Cette méthode fonctionne et est plus rapide que l'initiale. Mais mon nombre de lignes à traiter est très grand, 12000!

Je gagne tout de même quelques heures grâce à vous!

A très bientôt,

Juli3n974

 

[julien974]

Re : Simplifier une boucle While Wend

Peut être une autre piste!

plutôt que de supprimer ligne par ligne, ne pourrait on pas selectionner toutes les lignes à effacer sauf la plus en haut et les supprimer toutes.

A méditer!

juli3n974

 

[Guest]

Re : Simplifier une boucle While Wend

Julien,

Je t'ai fais une proposition dans ce sens dans le post#7 alors examine toutes les propositions qui te sont données, testes les et reviens.

A+

 

[Gael]

Re : Simplifier une boucle While Wend

Bonjour Julien974, bonjour à tous,

Pour le cas où il y ait des formules dans les cellules, il vaut mieux ajouter quel que soit le code retenu et comme l'a proposé Hasco dans son code:

Application.Calculation = xlCalculationManual
'
'
'
Application.Calculation = xlCalculationAutomatic

Le temps de traitement peut être très sensiblement diminué.

@+

Gael

 

[Staple1600]

Re : Simplifier une boucle While Wend

Re


Résultat immédiat avec ce code (20000 lignes testées )

(Puissant le Scripting.Dictionnary 😱 )

[FONT=Courier New][COLOR=darkblue]Sub[/COLOR] RemoveDuplicateEntries()
  [COLOR=Green]'auteur: [/COLOR][/FONT][COLOR=Green][I]Dave Brett[/I][/COLOR]
[FONT=Courier New]     [COLOR=darkblue]Dim[/COLOR] cel [COLOR=darkblue]As[/COLOR] Range, rng1 [COLOR=darkblue]As[/COLOR] Range, rng2 [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] ckValue [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
 
    [COLOR=darkblue]Dim[/COLOR] MyDic [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
    [COLOR=darkblue]Set[/COLOR] MyDic = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]Set[/COLOR] rng1 = Intersect(Columns("A"), ActiveSheet.UsedRange)
 
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] cel [COLOR=darkblue]In[/COLOR] rng1
        [COLOR=darkblue]If[/COLOR] cel.Value <> vbNullString [COLOR=darkblue]Then[/COLOR]
            [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] MyDic.exists(cel.Value) [COLOR=darkblue]Then[/COLOR]
                MyDic.Add cel.Value, cel.Row
            [COLOR=darkblue]Else[/COLOR]
                [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] rng2 [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
                    [COLOR=darkblue]Set[/COLOR] rng2 = Union(rng2, cel)
                [COLOR=darkblue]Else[/COLOR]
                    [COLOR=darkblue]Set[/COLOR] rng2 = cel
                [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] cel
    [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] rng2 [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR] rng2.EntireRow.Delete
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    [COLOR=darkblue]Set[/COLOR] MyDic = [COLOR=darkblue]Nothing[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR][/FONT]

 

[julien974]

Re : Simplifier une boucle While Wend

Ouahhhhhhhhhhhhhh! la classe!

Merci merci,

juli3n974