Boucle VBA for next limité ?

Résolu
eljojo_e Messages postés 1255 Statut Membre -  
eljojo_e Messages postés 1255 Statut Membre -
Bonjour,

J'ai une boucle qui me permet d'effacer des lignes qui n'appartiennent pas à une liste.

Cette boucle marche très bien pour 400 lignes, mais j'en est besoin pour traité 58723 lignes, et là le code tourne mais ne fonctionne pas.

Lorsque je met un "arrêt" sur le 1er next de mon code, je m'aperçois que excel ne traite pas se qu'il vient après, a savoir "If b > 0 Then".

Si quelqu'un à une idée,

Cordialement,

Sub ttt()

b = 0

For a = 58723 To 2 Step -1
    
    For aa = 90 To 2 Step -1
            
     If Range("d" & a).Value = Sheets("Feuil1").Range("a" & aa).Value Then b = b + 1
            
    Next  '1er next
        
    If b > 0 Then
            
        Rows(a & ":" & a).Select
        Selection.Delete Shift:=xlUp
        b = 0
    
    End If
        
Next
   


End Sub


Le geek ne descend pas du métro, il libère la rame.

4 réponses

  1. eljojo_e Messages postés 1255 Statut Membre 155
     
    C'est bon ! il suffit de déclarer en double.

    dim a, aa as double.

    ^^.
    0
  2. ccm81 Messages postés 11033 Statut Membre 2 434
     
    Bonjour

    RQ1. le type long devrait suffire pour a

    RQ2. Si j'ai compris, pour la boucle aa, dès que
    Range("d" & a).Value = Sheets("Feuil1").Range("a" & aa).Value,
    on incrémente b et à la sortie si b>0, on supprime la ligne a
    il me semble donc inutile d'aller au bout de la boucle aa, ce qui devrait accélérer l'exécution

    Sub ttt()
    dim a as long, aa as long, b as long
    b = 0
    For a = 58723 To 2 Step -1
      For aa = 90 To 2 Step -1         
        If Range("d" & a).Value = Sheets("Feuil1").Range("a" & aa).Value Then 
          b = 1
          exit for
        end if         
      Next aa      
      If b > 0 Then          
        Rows(a).Entirerow.Delete
        b = 0
      End If       
    Next a
    End Sub


    bonne journée
    0
  3. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour

    Avec 1 seule boucle
    Sub supprimer_ligne_si_égalite()
    Dim Lig As Long, Egal As Byte
    
    Application.ScreenUpdating = False
    For Lig = 58723 To 2 Step -1
              Egal = Rows(Lig).Find(what:=Cells(Lig, "D"), after:=Cells(Lig, "D")).Column
              If Egal > 4 Then Rows(Lig).Delete
    Next
    
    End Sub
     

    0
  4. eljojo_e Messages postés 1255 Statut Membre 155
     
    Merci, jai un peu modifié car ca ne fonctionné pas.

    Sub ttt()
    dim a as long, aa as long, b as long
    b = 0
    For a = 58723 To 2 Step -1
    For aa = 90 To 2 Step -1
    If Range("d" & a).Value = Sheets("Feuil1").Range("a" & aa).Value Then
    b = 1
    exit for
    else: b=0
    end if
    Next aa
    If b = 0 Then
    Rows(a).Entirerow.Delete
    b = 0
    End If
    Next a
    End Sub

    Le geek ne descend pas du métro, il libère la rame.
    0
    1. ccm81 Messages postés 11033 Statut Membre 2 434
       
      Exact pour le else b=0
      En fait tu peux supprimer ces deux lignes et mettre l'initialisation de b à 0 entre
      For a = 58723 ...
      et for aa = 90 ...
      0
    2. eljojo_e Messages postés 1255 Statut Membre 155
       
      C'est pas faux^^. En tout cas ca marche merci !
      0
    3. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      Excusez moi d'avoir dérangé
      0
    4. eljojo_e Messages postés 1255 Statut Membre 155
       
      o j'avais pas fait gaf, je pensé que c'était la même personne lol.
      0
    5. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      Je suis mort de rire, du....n
      0