Suppression de lignes Excel en fonction des valeurs Résolu/Fermé

Question

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

skk201 · Answer

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

CneSpaulding75 · Answer

C'est parfait, cela fonctionne du tonnerre!

Merci mille fois et bonne journée!!

Suppression de lignes Excel en fonction des valeurs

2 réponses

Discussions similaires