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

Bonjour



En ajoutant au début de ta macro

[font=Courier New]Application.ScreenUpdating = [color=darkblue]False[/color][/font]

il se passe quoi ?

 

[julien974]

Re : Simplifier une boucle While Wend

Bonjour,

Pas grand chose...

Je pense plus que c'est la structure de la boucle qui est lourde à traiter...

Merci,

juli3n974

 

[Guest]

Re : Simplifier une boucle While Wend

Bonjour Julien,

Essaies ceci:
Il n'y a plus de sélect

quand tu auras fini les tests décommentes la ligne On error Goto

Sub supprlignes()
    Dim derLigne As Long, ligne As Long
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
 
    'On Error GoTo FinSuppressionLigne
 
    With ActiveSheet
        derLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        If derLigne = 1 Then Exit Sub
        For ligne = derLigne To 2 Step -1
            If .Cells(ligne, 1) = .Cells(ligne - 1, 1) Then
                .Cells(ligne, 1).EntireRow.Delete
            End If
        Next ligne
    End With
 
FinsSuppressionLigne:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Mais pas sûr que cela soit beaucoup plus rapide.

A+

 

[Staple1600]

Re : Simplifier une boucle While Wend

Re



En reprenant une code bhbh avec Scripting .Dictionary

Mais il faut régler un dernier petit bug 😉

Sub supp_doublons()
Dim Doublons As Object, I As Long
Set Doublons = CreateObject("Scripting.Dictionary") 'on déclare l'objet Doublons
    For I = 2 To [A65000].End(xlUp).Row 'de la ligne 2 à la dernière ligne de D
        If Not Doublons.Exists(Cells(I, 1).Value) Then 'si la valeur n'existe pas, on l'insère dans l'objet
            Doublons.Add Cells(I, 1).Value, Cells(I, 1).Value
        Else
            Cells(I, 1).EntireRow.Delete ' elle existe, vide la cellule
        End If
    Next I
End Sub

 

[pierrejean]

Re : Simplifier une boucle While Wend

bonjour julien974

Salut Staple

A tester:

Application.ScreenUpdating = False
For n = Range("A2").End(xlDown).Row To 2 Step -1
  If Range("A" & n) = Range("A" & n - 1) Then Rows(n).Delete
Next n
Application.ScreenUpdating = True

Edit : Salut a tous (avais pas rafraichi)

 

[Guest]

Re : Simplifier une boucle While Wend

Re Julien,

Autre suggestion:

Avec cette macro toutes les lignes concernées sont supprimer ensemble et d'un seul coup à la fin. Attention si ton pc n'a pas beaucoup de mémoire et qu'il y a vraiement beaucoup de lignes à supprimer.
Je ne connais pas les limite de la methode Union.

Sub supprlignes()
    Dim derLigne As Long, ligne As Long
    Dim plageASupprimer As Range
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    'On Error GoTo FinSuppressionLigne
    
    With ActiveSheet
        derLigne = .Range("A" & .Rows.Count).End(xlUp).Row
        If derLigne = 1 Then Exit Sub
        For ligne = derLigne To 2 Step -1
            If .Cells(ligne, 1) = .Cells(ligne - 1, 1) Then
                If plageASupprimer Is Nothing Then
                   Set plageASupprimer = .Cells(ligne, 1)
                Else
                   Set plageASupprimer = Union(plageASupprimer, .Cells(ligne, 1))
                End If
            End If
        Next ligne
    End With
    If Not plageASupprimer Is Nothing Then plageASupprimer.EntireRow.Delete
FinsSuppressionLigne:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

A+

Hello PierreJean, Staple

 

[julien974]

Re : Simplifier une boucle While Wend

Merci pour vos réponses.

En fait je voudrait garder la première ligne. Donc partir du bas comme le fait Jeanpierre n'est pas idéal... Pourrais tu le faire à partir du haut?

Merci à toi

 

[Staple1600]

Re : Simplifier une boucle While Wend

Re à tous, Hasco, Pierrejean


Après bhbh, j'emprunte à Boisgontier

Ici recopie des valeurs uniques en colonne B (mieut vaux qu'elle soit vide)

[FONT=Courier New][COLOR=darkblue]Sub[/COLOR] NonDoublons2modif()
[COLOR=darkblue]Set[/COLOR] mondico1 = CreateObject("Scripting.Dictionary")
[COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] c [COLOR=darkblue]In[/COLOR] Range([A1], [A65000].End(xlUp))
[COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] mondico1.Exists(c.Value) [COLOR=darkblue]Then[/COLOR] mondico1.Add c.Value, c.Value
[COLOR=darkblue]Next[/COLOR] c
Range("B1:B" & mondico1.Count) = Application.Transpose(mondico1.items)
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR][/FONT]

 

[PascalXLD]

Re : Simplifier une boucle While Wend

Merci pour vos réponses.

En fait je voudrait garder la première ligne. Donc partir du bas comme le fait Jeanpierre n'est pas idéal... Pourrais tu le faire à partir du haut?

Merci à toi

Bonjour

Pierrejean a raison il faut partir du bas dans cette boucle sinon toutes lignes ne sont pas testées

sinon modifies juste

For n = Range("A2").End(xlDown).Row To 2 Step -1

en

For n = Range("A2").End(xlDown).Row To 3 Step -1

 

[Guest]

Re : Simplifier une boucle While Wend

Julien,

Mes amis, PierreJean, Pascal, je ne voudrais pas chipoter mais si notre ami veut gagner en temps de traitement, il a tout intérêt à mettre la dernière ligne dans une variable avant la boucle. Sinon, cela oblige VB a recalculer à chaque passage de boucle la valeur de Range("A2").End(xlDown).Row.
Sur 100 lignes les temps sont infimes mais sur 10000 ou plus ça fait beaucoup.

bon appétit à ceux qui prennent le temps de manger.
A+

 

[PascalXLD]

Re : Simplifier une boucle While Wend

RE

Oui tu as raison

Sur le coup je répondais surtout au

Donc partir du bas comme le fait Jeanpierre n'est pas idéal... Pourrais tu le faire à partir du haut?

En plus il s'agit de Pierrejean car jeanpierre ce n'est pas le même personnage

 

[Staple1600]

Re : Simplifier une boucle While Wend

Re à tous


Moi j'ai, une question pour tous

Mais bon appétit à tous d'abord

La question maintenant

Pourquoi ce code plante au delà de 5483 lignes (remplies en colonne A) ?

C'est le Transpose qui semble broncher

Incompatibilité de Type me dit Excel

Sub NonDoublons2modXXif()
Set mondico1 = CreateObject("Scripting.Dictionary")
For Each c In Range([A1], [A65000].End(xlUp))
If Not mondico1.Exists(c.Value) Then mondico1.Add c.Value, c.Value
Next c
Range("B1:B" & mondico1.Count) = Application.Transpose(mondico1.items)
End Sub

 

[PascalXLD]

Re : Simplifier une boucle While Wend

RE

Oui il y a des limites au transpose

Je te retrouve le fil

 

[PascalXLD]

Re : Simplifier une boucle While Wend

RE

voilà le fil

https://www.excel-downloads.com/threads/application-transpose-bug-erreur-13.60883/