suppression double

Question

Bonjour à tous, voici mon probleme:


J'ai ce petit code de trie, qui est censé marché correctement, mais mon probleme est qu'il lui faut un temps e,orme meme pour trier 200lignes, quelqu'un saurrait-il pourkoi?


Sub Main2()


 


  Dim rRange As Range
  Dim rCell As Range
  Set rRange = Range([A1], [A1].End(xlDown))
  For Each rCell In rRange
    Do While rCell = rCell.Offset(1, 0)
      rCell.Offset(1, 0).EntireRow.Delete
    Loop
  Next rCell


    
    
End Sub

Merci d'avance!!

BruNews · Answer

J'ai testé ça, quasi instantané sur 320 cellules.


Sub DelDoublons()
  Dim c As Range, d As Range, todel As Range
  Set c = Range("a1")
  Application.ScreenUpdating = False
  While Not IsEmpty(c)
    Set d = c.Offset(1, 0)
    While Not IsEmpty(d)
      If c = d Then
        Set todel = d
        Set d = d.Offset(1, 0)
        todel.EntireRow.Delete
       Else
        Set d = d.Offset(1, 0)
      End If
    Wend
    Set c = c.Offset(1, 0)
  Wend
  Application.ScreenUpdating = True
End Sub

ciao...
BruNews, MVP VC++

devilft7 · Answer

Slt BruNews, merci bien pour les doublons c top, mainitenan j'ai une deuxième question c'est sur un prog de tri, voila ce que j'ai fai, et mon probleme est que lors de l'execution, j'ai un beug sur la première ligne, mais impossible de savoir pkoi, le noms de ma feuille qui se trouve dans la feuille 2 d'un classeur est correct, la plage de cellule selectionné aussi, dc je vois pas trop, si ta une idéé voici le code:

Range("A2:E600").Select


ActiveWorkbook.Worksheets("Suivi Fab S3507").Sort.SortFields.Clear


ActiveWorkbook.Worksheets("Suivi Fab S3507").Sort.SortFields.Add
Key = Range("A2:E600")
SortOn = xlSortOnValues
Order = xlAscending
DataOption = xlSortNormal


    With ActiveWorkbook.Worksheets("Suivi Fab S3507").Sort


        .SetRange Range("A2:E600")


        .Header = xlGuess


        .MatchCase = False


        .Orientation = xlTopToBottom


        .SortMethod = xlPinYin


        .Apply


    End With

Merci

Suppression double

2 réponses

Votre réponse

Discussions similaires