Suppression de lignes Excel en fonction des valeurs

Résolu/Fermé
CneSpaulding75 Messages postés 2 Date d'inscription lundi 30 juin 2014 Statut Membre Dernière intervention 1 juillet 2014 - 1 juil. 2014 à 14:58
skk201 Messages postés 938 Date d'inscription jeudi 11 septembre 2008 Statut Membre Dernière intervention 16 octobre 2016 - 2 juil. 2014 à 08:37
Bonjour,

J'aimerais savoir si une macro existait afin de supprimer des lignes d'un tableur Excel sous certaines conditions, je m'explique:

J'ai 2 colonnes A & B, le but ultime est de tracer B=fct(A).
Cependant, à une même valeur de A correspond plusieurs valeurs de B.
L'idée est de faire correspondre une valeur de A à une unique valeur de B (avec comme condition que la valeur de B soit le maximum) et donc de supprimer toutes les autres.

Ex:

A B
0.1 1
0.1 2
0.1 3
0.2 1
0.2 3

deviendrait

A B

0.1 3
0.2 3

Je vous transmet un exemple de 1500 lignes => https://www.cjoint.com/?0GboPZ8w44s

Le fichier entier contient 32641 lignes, les valeurs commencent en ligne 2.

Merci de votre lecture, et j'espere, de votre aide ;)

Cordialement,

Victor
A voir également:

2 réponses

skk201 Messages postés 938 Date d'inscription jeudi 11 septembre 2008 Statut Membre Dernière intervention 16 octobre 2016 54
1 juil. 2014 à 15:31
Bonjour

Tout simple

Tu ouvres ton classeur puis [ALT]+[F11]

Là tu fais un nouveau module et tu y colle ce code :

Public MAX_Ligne As Integer
Sub MAXI()
Call Compter_L
For Ligne_Delete = 3 To MAX_Ligne
Q_Plusgrand Cells(Ligne_Delete, 1).Value, Cells(Ligne_Delete, 2).Value, Ligne_Delete
Next
    Range("A2:B" & MAX_Ligne).Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("A2:B" & MAX_Ligne)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

Function Compter_L()
Compter_L = 2
Do While Cells(Compter_L, 1) <> ""
Compter_L = Compter_L + 1
Loop
MAX_Ligne = Compter_L - 1
End Function

Function Q_Plusgrand(Ref As String, Comparatif As Integer, ByVal Ligne_D As Integer)
For Ligne_Read = 2 To Ligne_D - 1
    If Cells(Ligne_Read, 1).Value = Ref Then
        If Cells(Ligne_Read, 2).Value > Comparatif Then
            Range(Cells(Ligne_D, 1), Cells(Ligne_D, 2)).ClearContents
        Else
            Range(Cells(Ligne_Read, 1), Cells(Ligne_Read, 2)).ClearContents
        End If
        Exit Function
    End If
Next
End Function


Tu retournes au classeur et tu fais [ALT]+[F8], et tu executela macro "MAXI".

Bonne journée


Si tu as un problème n'hésite pas a demander
1
CneSpaulding75 Messages postés 2 Date d'inscription lundi 30 juin 2014 Statut Membre Dernière intervention 1 juillet 2014
1 juil. 2014 à 16:49
C'est parfait, cela fonctionne du tonnerre!

Merci mille fois et bonne journée!!
0
skk201 Messages postés 938 Date d'inscription jeudi 11 septembre 2008 Statut Membre Dernière intervention 16 octobre 2016 54
2 juil. 2014 à 08:37
Pas de soucis bonne journée
0