Compléter une macro par un deuxième tri

libellule85

XLDnaute Accro
Bonsoir le forum,

Je remercie une nouvelle fois job75 pour la macro suivante : quand on met une date sans astérisque cela classe du plus ancien au plus récent, et quand on ajoute l'astérisque à une date cela classe du plus récent au plus ancien.
J'aimerais rajouter, si cela est possible, un deuxième classement : quand il y a un "x" dans la cellule de droite cela met la ligne en dernier suivant le classement choisi.
Actuellement, il faudrait que toutes les lignes barrées soient mises à la fin du classement (et classées par date) et si le classement est du plus ancien au plus récent il faudrait que les lignes barrées soient au début.
J'espère avoir été clair dans mes explications.
D'avance merci pour votre aide

VB:
Private Sub Worksheet_Change(ByVal Target As Range) 'Un grand merci à Job75 pour cette macro
Dim dat$
With ListObjects(1).DataBodyRange
    If Intersect(Target, .Columns(1)) Is Nothing Or Target.Count > 1 Then Exit Sub
    If Target = "" Then
        Rows(Target.Row).Delete
    Else
        If Right(Target, 1) = "*" Then dat = Replace(Target, "*", "")
        If IsDate(dat) Then Target = CDate(dat)
        .Sort .Columns(1), IIf(dat = "", 1, 2), Header:=xlYes
    End If
End With
End Sub
 

Pièces jointes

  • Libellule85 07 01 17.xlsm
    32.1 KB · Affichages: 43

job75

XLDnaute Barbatruc
Bonsoir charmante(e?) libellule85,
Code:
Private Sub Worksheet_Change(ByVal Target As Range) 'Un grand merci à Job75 pour cette macro
Dim dat$
With ListObjects(1).DataBodyRange
    If Intersect(Target, .Columns(1)) Is Nothing Or Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    On Error Resume Next
    If Target = "" Then
        Rows(Target.Row).Delete
    Else
        .Columns(7).NumberFormat = "0;;"
        .Columns(7).SpecialCells(xlCellTypeBlanks) = 0
        If Right(Target, 1) = "*" Then dat = Replace(Target, "*", "")
        If IsDate(dat) Then Target = CDate(dat)
        .Sort .Columns(7), IIf(dat = "", 1, 2), .Columns(1), , IIf(dat = "", 1, 2), Header:=xlYes
        .Columns(7).SpecialCells(xlCellTypeConstants, 1) = ""
    End If
    Application.EnableEvents = True
End With
End Sub
Bonne fin de soirée.
 
Dernière édition:

job75

XLDnaute Barbatruc
Re,

Et il ne se passe rien non plus quand on ajoute des dates sur votre fichier du post #1.

Le tableau Excel ne s'agrandit pas, le fichier est probablement vérolé.

Avec votre dernier fichier du 30 12 16 ci joint aucun problème.

A+
 

Pièces jointes

  • Essai libellule85 30 12 16(2).xlsm
    24.8 KB · Affichages: 37

Discussions similaires

  • Résolu(e)
XL 2021 macro
Réponses
9
Affichages
427