XL 2016 Tri date et afficher la plus récente avec sa date de validité correspondante

FaruSZ

XLDnaute Occasionnel
Bonjour j'ai le tableau suivant:
71503_5f68a6be2baf8154848137.png


Je dois afficher les informations des lignes 20, 21, 22 dans une listbox avce ce code:
VB:
Private sub cb_click()
Set ws = ActiveWorkbook.Worksheets(Personne)
fin_col_Habilit = ws.Cells(20, 256).End(xlToLeft).Column
UF_Profil_Edit1.ListBox_Habilit.ColumnCount = 3
UF_Profil_Edit1.ListBox_Habilit.ColumnWidths = "150;150;150"
For i = 2 To fin_col_Habilit
UF_Profil_Edit1.ListBox_Habilit.AddItem ws.Cells(20, i)
UF_Profil_Edit1.ListBox_Habilit.List(UF_Profil_Edit1.ListBox_Habilit.ListCount - 1, 1) = ws.Cells(21, i)
UF_Profil_Edit1.ListBox_Habilit.List(UF_Profil_Edit1.ListBox_Habilit.ListCount - 1, 2) = ws.Cells(22, i)
Next i
tri_Habi
end sub

Avec tri_Habi est le résultat deu tri des lignes 16 et 17 pour prendre seulement les formation avec les dates les plus récentes et les afficher dans une listbox en utilisant ce code:

Code:
Loop Until Not ech

      ' conversion des numéros en texte (pour le dico et la listbox)
      ' et les fausses dates (en texte) en vraies dates
      On Error GoTo PasDate
      For i = 2 To UBound(t)
         t(i, 1) = CStr(t(i, 1))
         If TypeName(t(i, 2)) = "String" Then t(i, 2) = 1 * DateSerial(Right(t(i, 2), 4), Mid(t(i, 2), 4, 2), Left(t(i, 2), 2))
      Next i
      On Error Resume Next

      'remplissage de dico
      Set dico = CreateObject("scripting.dictionary")
      dico.CompareMode = TextCompare
      For i = 2 To UBound(t)
         If t(i, 1) <> "" Then
            If Not dico.Exists(t(i, 1)) Then
               dico.Add t(i, 1), t(i, 2)
            Else
               If t(i, 2) > dico(t(i, 1)) Then dico(t(i, 1)) = t(i, 2)
            End If
         End If
      Next i

   'Transfert de dico vers le tableau r pour la liste
   ReDim r(1 To dico.Count, 1 To 2): i = 0
   For Each x In dico.Keys: i = i + 1: r(i, 1) = x: r(i, 2) = dico(x): Next

   'remplissage des lignes 10 et 11 de la feuille PERSONNE
   .Range("b20:b21").Resize(, Columns.Count - 1).Clear
'   .Range("b13").Resize(1, UBound(r)).NumberFormat = "000"
   .Range("b20").Resize(1, UBound(r)).HorizontalAlignment = xlCenter
   .Range("b21").Resize(1, UBound(r)).NumberFormat = "dd/mm/yyyy"
   .Range("b20").Resize(2, UBound(r)).Borders.LineStyle = xlContinuous
   .Range("b20:b21").Resize(2, UBound(r)) = Application.Transpose(r)

   End With

   'remplissage de la listbox
    For i = 1 To UBound(r): r(i, 1) = Format(r(i, 2), "dd/mm/yyyy"): Next

   'For i = 1 To UBound(r): r(i, 1) = Format(r(i, 1), "000"): r(i, 2) = Format(r(i, 2), "dd/mm/yyyy"): Next

   With ListBox1
      .ColumnCount = 2
      .ColumnHeads = False
      .ColumnWidths = .Width * 0.7        '& ";" & .Width * (1 - 0.6 + 0.1)
      .List = r
   End With
   Exit Sub

'
PasDate:
Exit Sub
   End
End Sub



Je veux modifier le code de telle sorte faire le tri des lignes 16,17 et 18 pour que je puisse afficher la date de validité, la je suis bloquée je sais pas cmn proceder.

Merci pour vos propositions.
 

Discussions similaires

Réponses
11
Affichages
285
Réponses
2
Affichages
223

Statistiques des forums

Discussions
312 174
Messages
2 085 951
Membres
103 058
dernier inscrit
florentLP