XL 2013 [Résolu] Tri Quick Sort sur dates

[Lone-wolf]

Bonsoir le Forum

Il y a possiblilité de faire le tri sur l'année au lieu des jours avec la macro de Jacques Boisgontier Quick Sort?

Private Sub Tri(a(), gauc, droi, colTri)
Dim Temp, C, ref, g, d

   ref = a((gauc + droi) \ 2, colTri)
   g = gauc: d = droi
   Do
     Do While a(g, colTri) < ref: g = g + 1: Loop
     Do While ref < a(d, colTri): d = d - 1: Loop
       If g <= d Then
          For C = LBound(a, 2) To UBound(a, 2)
             Temp = a(g, C): a(g, C) = a(d, C): a(d, C) = Temp
          Next
          g = g + 1: d = d - 1
       End If
   Loop While g <= d
   If g < droi Then Tri a, g, droi, colTri
   If gauc < d Then Tri a, gauc, d, colTri
End Sub

 

[job75]

Bonsoir Lone-wolf,

Il suffit de construire préalablement le tableau a().

A+

 

[Lone-wolf]

Bonsoir Gerard

@job75

Là tu me pose une colle sérieuse et je vais pas m'en sortir tout seul.

J'ai ensuite ceci qui fait appel

Private Sub CheckBox3_Click()  'Date
Dim a()
If CheckBox3.Value = True Then
CheckBox1.Value = False
CheckBox2.Value = False
CheckBox4.Value = False
CheckBox5.Value = False

   a = ListBox1.List
   Tri a(), LBound(a), UBound(a), 4
   ListBox1.List = a
End If
End Sub

 

[BOISGONTIER]

Bonjour,

Private Sub UserForm_Initialize()
  Me.ListBox1.ColumnCount = [tableau1].Columns.Count
  Me.ListBox1.ColumnWidths = "50;50;20;50;50"
  Me.ListBox1.List = [tableau1].Value
  Me.ListBoxOption.ListStyle = fmListStyleOption
  Me.ListBoxOption.ColumnWidths = "30"
  Me.ListBoxOption.List = Application.Transpose(Range("Tableau1").ListObject.HeaderRowRange.Value)
End Sub

Private Sub ListBoxOption_Click()
   Dim Tbl()
   Tbl = Me.ListBox1.List
   Tri Tbl, LBound(Tbl), UBound(Tbl), Me.ListBoxOption.ListIndex
   Me.ListBox1.List = Tbl
End Sub

Private Sub Tri(a(), gauc, droi, colTri)
   ref = a((gauc + droi) \ 2, colTri)
   g = gauc: d = droi
   Do
     Do While a(g, colTri) < ref: g = g + 1: Loop
     Do While ref < a(d, colTri): d = d - 1: Loop
       If g <= d Then
          For C = LBound(a, 2) To UBound(a, 2)
             Temp = a(g, C): a(g, C) = a(d, C): a(d, C) = Temp
          Next
          g = g + 1: d = d - 1
       End If
   Loop While g <= d
   If g < droi Then Tri a, g, droi, colTri
   If gauc < d Then Tri a, gauc, d, colTri
End Sub

jb

 

[Lone-wolf]

Bonjour Gerard, Jacques, le Forum

@BOISGONTIER : merci pour ton intervention. Je vais remplacer la macro par celle-ci.

EDIT: je ne comprends pas pourquoi ça ne marche pas, est-ce que cela viens du faite que tu utilise un tableau? . Le formulaire en question est le 2, l'initialisation du tableau ce fait à partir de la macro AutoSize_Columns du module Md_List_Form > Tbl = .Range("a2" & .Range("p" & Rows.Count).End(xlUp).Row).Value.

 

[BOISGONTIER]

Je n'interviens pas sur des programmes déjà écrits.
Voilà un autre exemple de programme avec tableau dynamiques.

http://boisgontierjacques.free.fr/pages_site/TableauDyn.htm

jb

 

[Lone-wolf]

Re Jacques

Cette fois c'est ok. Voici comment j'ai fait pour cette coolonne.

Private Sub CheckBox3_Click()  'Date de naissance
Dim T, Tb()

    If CheckBox3.Value = True Then
        CheckBox1.Value = False
        CheckBox2.Value = False
        CheckBox4.Value = False
        CheckBox5.Value = False
              
        T = WsB.Range("a2:p" & WsB.Range("p" & Rows.Count).End(xlUp).Row).Value
        ListBox1.List = T

        Tb = ListBox1.List
        Tri Tb, LBound(Tb), UBound(Tb), 4
        ListBox1.List = Tb

        With ListBox1
            For i = 0 To .ListCount - 1
                .List(i, 4) = Format(.List(i, 4), "dd.mm.yyyy")
            Next i
        End With

    End If

End Sub

 

[BOISGONTIER]

Les cases d'options placées dans un Frame sont liées (cocher une option désactive les autres) .
Dans ce cas, elles sont plus adaptées que les cases à cocher.

jb

 

[Lone-wolf]

Re Jacques

D'accord. Mais visuellement, je préfère les cases à cocher.