Macro trier

[KTM]

bonsoir chers tous

Jai des bases de données que je renseigne via un USF.
J'aimerais grace a un bouton sur mon USF trier au besoin la colonne des Mois selon la date la plus récente a la plus ancienne.
Merci

 

[Dranreb]

Bonsoir.
Apparemment dans votre UserForm vous oubliez en l'écrivant dans la cellule de convertir en Date le texte d'une TextBox.

 

[KTM]

Bonsoir.
Apparemment dans votre UserForm vous oubliez en l'écrivant dans la cellule de convertir en Date le texte d'une TextBox.

Merci
J'ai remedié au format Date
Ma préoccupation demeure !!

 

[ChTi160]

Bonjour KTM
Bonjour Bernard,Le Forum
une approche

'dans module de la feuille "ds" pour l'exemple
Option Explicit
Private Sub Worksheet_Activate()
Trier_BD "ds"
End Sub
'*******************'
'Dans le Module1
Option Explicit
Public Function Trier_BD(shtname)
With Worksheets(shtname)
 With .Range("A1").CurrentRegion
   .Sort key1:=.Cells(2, 2), order1:=xlDescending, Header:=xlYes
 End With
End With
End Function

Bonne journée
jean marie

 

[mapomme]

Bonjour @KTM, à tous,

Un code qui convertit le texte en date puis qui trie le tableau (basé sur le 1er fichier et ici pour la feuille "dt") :

Sub Convertir_Trier()
Dim derlig&, dercol&, xrg As Range

Application.ScreenUpdating = False
With Worksheets("dt")
  'conversion en date 
  If .FilterMode Then .ShowAllData
  derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
  Set xrg = .Range("b2:b" & derlig)
  dercol = .UsedRange.Column + .UsedRange.Columns.Count
  With .Range(.Cells(2, dercol), .Cells(derlig, dercol))
    .FormulaR1C1 = "=IF(RC2="""","""",IF(ISTEXT(RC2),DATEVALUE(RC2),RC2))"
    xrg.Value = .Value
    .EntireColumn.Delete
  End With
  xrg.HorizontalAlignment = xlGeneral
  xrg.NumberFormat = "mmm-yy"
  'Tri
  With .Range("a1:f" & derlig)
    .Sort key1:=.Range("b1"), order1:=xlAscending, Header:=xlYes
  End With
End With
Application.ScreenUpdating = True

End Sub

 

[KTM]

Merci ChT160 et mapomme
Les deux propositions sont testées et sont excellentes.
Mais je voudrais m'attarder sur celle de mapomme qui me fera faire d'une pierre deux coups et mapomme , je trouve votre code de conversion en date intéressante au point que je suis tenté de vous demander d'y revenir et apporter des explications ou commentaires pour que je puisse le déchiffrer et l'adapter à d'autres situations. Encore merci à vous!!!!!!

 

[mapomme]

Re @KTM,

Le fichier avec le code et des commentaires.

 

[job75]

Bonjour à tous,

Du très classique :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim tablo, i&
On Error Resume Next
With Sh.[A1].CurrentRegion
    tablo = .Columns(2).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 2 To UBound(tablo): tablo(i, 1) = CDate("1-" & tablo(i, 1)): Next 'conversion
    .Columns(2) = tablo 'restitution
    .Sort .Columns(2), xlDescending, Header:=xlYes 'tri
End With
End Sub

A+

 

[KTM]

Bonjour à tous,

Du très classique :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim tablo, i&
On Error Resume Next
With Sh.[A1].CurrentRegion
    tablo = .Columns(2).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 2 To UBound(tablo): tablo(i, 1) = CDate("1-" & tablo(i, 1)): Next 'conversion
    .Columns(2) = tablo 'restitution
    .Sort .Columns(2), xlDescending, Header:=xlYes 'tri
End With
End Sub

A+

Merci à vous tous pour votre soutien et vos contributions combien précieuses !!!!!!

 

[KTM]

Re @KTM,

Le fichier avec le code et des commentaires.

Merci pour tout et toujours !!!