Supprimer des lignes excel en fonction d'une valeur Fermé

Question

Bonjour à tous,
Je cherche une macro pour me débarrasser de lignes excel sous certaines conditions. 
L'idée principale est de supprimer un certain nombre de  lignes ayant des valeurs dupliquées  dans la colonne A en fonction de la valeur d'une autre cellule (son maximum).
Pour être plus précis voici un exemple:
A B C D ... N
1     7
1     6
1     3
2     2
2     1
2     4
3     5
3     1
3     6
.     .
.     .
.     .
300000    .

Je ne souhaite donc garder que les lignes en gras et supprimer les autres.
Je tiens à préciser que le fichier fait environ 300000 lignes.
La colonne A est celle qui contient les valeurs dupliquées, le tableau sera trié en fonction de cette colonne.
La colonne N contient un nombre allant de 1 à 40. Pour chaque valeur de la colonne A, le nombre contenu dans la colonne N ne sera jamais identique.

Merci d'avance pour toute aide potentielle

michel_m · Answer

Bonjour,

Ton tableau s'arr^te il à la colonne N ? sinon , à quelle colonne ?

Dans la colonne A , le tri croissant est il déjà fait  (pas bien compris le "sera") ?

les nombres dans la colonne A sont ils incrémentés de 1 à chaque changement de valeur dupliquée ?

le mieux serait de joindre un extrait de ton classeur avec 1000 ou 2000 lignes au maximum

pour joindre une piècemettre le classeur sans données confidentielles en pièce jointe surhttp://cjoint.com/ puis copier l'adresse du lien et la coller dans le message de réponse

michel_m · Answer

En supposant que le tableau s'arr^te en colonne N et commence en ligne 2
Merci de communiquer la durée pour 300 000 lignes 
proposition de code

Option Explicit'----------------------------Sub epurer_svt_max()Dim Derlig As Long, T_in()Dim Dico As Object, Idx As Long, Maxi As Byte, Cle As Long, Nbre As LongDim T_lignemaxi(), T_out(), Lig As Long, Cptr As Long, Col As ByteDim Start As Single 'essai rapidité à supprimer apres essais'-----initialisations     Start = Timer 'essai rapidité à supprimer apres essais     Application.ScreenUpdating = False     Derlig = Columns("A").Find("*", , , , , xlPrevious).Row     T_in = Range("A2:N" & Derlig) 'n=14     Set Dico = CreateObject("scripting.dictionary")     '----création du couple valeur dupliquée  /  index de son max     For Idx = 1 To UBound(T_in)          If Not Dico.exists(T_in(Idx, 1)) Then               Dico.Add T_in(Idx, 1), Idx                    'détermination valeur initiale maxi                    Maxi = T_in(Idx, 14)                    Cle = T_in(Idx, 1) 'mémorisation clé          Else               If T_in(Idx, 14) > Maxi Then                    'détermination nouvelle valeur maxi et ligne                    Dico.Item(Cle) = Idx                    Maxi = T_in(Idx, 14)                End If          End If      Next     'restitution de la selection des lignes avec maxi col_n     T_lignemaxi = Dico.items     '-----construction du tableau epuré     Nbre = Dico.Count     ReDim T_out(1 To Nbre, 1 To 14)     Cptr = 1     For Idx = 0 To Nbre - 1          Lig = T_lignemaxi(Idx)          For Col = 1 To 14               T_out(Cptr, Col) = T_in(Lig, Col)          Next     Cptr = Cptr + 1     Next     ' ----restitution du tableau épuré     Range("A2:N" & Derlig).Clear  ' à valider après essais      With Range("R2").Resize(Nbre, 14) ' R2 pour essai à remplacer par A2 au final          .Value = T_out          .Borders.Weight = xlThin     End With'----essai rapidité à supprimer apres essais     Application.ScreenUpdating = False     MsgBox "tableau épuré en " & Timer - Start & " sec."End Sub
 
 Michel

Supprimer des lignes excel en fonction d'une valeur

2 réponses

Discussions similaires