XL 2016 Trie de date avec VBA

Dranreb à dit:

Bonjour.
Conseil: enregistrez des dates dans vos cellule. Là ce sont des textes que vous y mettez.

VB:

    On Error Resume Next
    .Range("C" & ligne) = CDate(tbDateJour.Text)
    .Range("D" & ligne) = CDate(tbDLC.Text)
    On Error Goto 0

Et aussi: ne laissez pas de ligne vide dans les tableaux.

Après quoi je l'aurais à peu près écrite comme ça votre procédure :

VB:

Private Sub CommandButton1_Click()
   Dim TVL(1 To 1, 1 To 4), LOt As ListObject, Qté As Long, Numéro As Long
   On Error Resume Next
   TVL(1, 1) = ListBox1.Value
   TVL(1, 2) = CDate(tbDateJour.Text): If Err Then tbDateJour.SetFocus: MsgBox Err.Description, vbExclamation, Me.Caption: Exit Sub
   TVL(1, 3) = CDate(tbDLC.Text): If Err Then tbDLC.SetFocus: MsgBox Err.Description, vbExclamation, Me.Caption: Exit Sub
   TVL(1, 4) = CCur(tbprix.Text): If Err Then Me.tbprix.SetFocus: MsgBox Err.Description, vbExclamation, Me.Caption: Exit Sub
   If MsgBox("confirmez-vous l'ajout des données?", vbYesNo, "confirmation") = vbNo Then Exit Sub
   Qté = CByte(tbQte.Text): If Err Then Qté = 1
   On Error GoTo 0
   Set LOt = Sheets("Stock").ListObjects(1)
   Numéro = WorksheetFunction.Max(LOt.DataBodyRange.Columns(0))
   Do While Qté > 0
      Numéro = Numéro + 1
      With LOt.ListRows.Add.Range
         .Cells(1, 0).Value = Numéro
         .Value = TVL
         End With
      Qté = Qté - 1: Loop
   LOt.Sort.Apply
   Me.tbDLC = ""
   Me.tbQte = ""
   Unload Me
   Unload base
   End Sub

Cliquez pour agrandir...

Dranreb à dit:

Les deux instructions ne sont plus à remplacer dans votre Sub CommandButton1_Click puisque je vous en ai ensuite proposé une complète qui la remplacera mieux à mon avis.

Cliquez pour agrandir...