XL 2016 macro : trie alphabétique sans redondance

[chifounou]

Bonjour,

J'utilise cette macro, pour ranger dans l'ordre alphabétique la saisie d'emails au sein d'une même colonne

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A3:A2503")) Is Nothing Then
Range("A3:A2503").Sort Key1:=Range("A3"), Order1:=xlAscending
End If
End Sub

Comment faire pour que si je tape un email en doublon, il ne soit pas pris en compte et n'apparaisse qu'une fois malgré tout dans ma colonne ?

Merci à vous

 

[phlaurent55]

Bonjour chifounou,

peut-être avec ceci:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A3:A2503")) Is Nothing Then
Range("A3:A2503").RemoveDuplicates
Range("A3:A2503").Sort Key1:=Range("A3"), Order1:=xlAscending
End If
End Sub

à+
Philippe

 

[chifounou]

Bonjour phlaurent, ta solution n'a malheureusement aucun effet chez moi

 

[Victor21]

Bonsoir, chifounou.

Dommage que l'absence de fichier exemple ne nous permette pas de vous expliquer pourquoi la solution de Philippe (que je salue) n'a aucun effet chez vous...

 

[chifounou]

Bonsoir Philippe,

Merci de vous joindre à la partie !

Voici le fichier sample

Si vous tapez daniel@gmail.com en colonne A, case vide, il apparaitra en double dans la liste malgré tout

 

[DoubleZero]

Bonjour, chifounou, Philippe , Victor21 , le Forum,

Comme ceci ?

Option Explicit
Private Sub Worksheet_Change(ByVal c As Range)
    If Not Intersect(c, Range("a3:a65000")) Is Nothing Then
        Application.EnableEvents = False
        Range("a:a").RemoveDuplicates Columns:=1, Header:=xlYes
        Application.EnableEvents = True
        Range("a3:a65000").Sort Key1:=Range("a3"), Order1:=xlAscending
    End If
End Sub

A bientôt

 

[Victor21]

Re,

Il manque l'argument obligatoire. Essayez :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    If Not Intersect(Target, Range("A3:A2503")) Is Nothing Then
        Range("A3:A2503").RemoveDuplicates Columns:=1
        Range("A3:A2503").Sort Key1:=Range("A3"), Order1:=xlAscending
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Bonsoir, chère OO ! Grillé sur le fil !

 

[chifounou]

Merci à vous deux !
Pour une raison mystèrieuse celà supprime ma mise en forme conditionnelle pour les cases vides non triées mais celà n'a pas d'importance.

Bonne soirée

 

[DoubleZero]

Re-bonjour,

... Pour une raison mystèrieuse celà supprime ma mise en forme conditionnelle...

A tester : supprimer la MFC de la colonne "a", puis utiliser le code ci-après.

Option Explicit
Private Sub Worksheet_Change(ByVal c As Range)
    If Not Intersect(c, Range("a3:a65000")) Is Nothing Then
        Application.EnableEvents = False
        Range("a:a").RemoveDuplicates Columns:=1, Header:=xlYes
        Application.EnableEvents = True
        Range("a3:a65000").Sort Key1:=Range("a3"), Order1:=xlAscending
        With Range("a3:a65000").SpecialCells(xlCellTypeConstants)
            .Borders.Value = 0
            .Borders(xlEdgeLeft).Color = -65281
            .Borders(xlEdgeRight).Color = -65281
        End With
    End If
End Sub

A bientôt

 

[chifounou]

Merci merci !