XL 2019 Convertir date en mois et année par macro

[Rabeto]

Bonjour,

Y a t-il y moyen de convertir une liste de date en Mois et année par Macro svp,

Par formule pas de soucis, mais j'ai tellement beaucoup de ligne à convertir et ça ralenti mon fichier,
Donc je penses que par VBA serai mieux

PS : Résultats à mettre dans la colonne des dates si possible, et dans une colonne à côté l'année

Merci

 

[mapomme]

Bonsoir @Rabeto ,

Placer le code qui suit dans un module. Ce code agit sur la feuille active.
Suivant le format du mois désiré, modifier "mmmm" dans pour :

• "mmmm" pour un mois en lettre : nom complet du mois
• "mmm" pour un mois en lettre : nom abrégé du mois
• "mm" pour un mois en chiffre : toujours sur deux chiffres
• "m" pour un mois en chiffre : sur un ou deux chiffres

Sub dateMoisAnnee()
Const Mois = "ja,f,mar,av,mai,juin,juil,ao,se,oc,no,d"
Dim deb!, der&, tmois, t, i&, k&, x, s
   deb = Timer
   Application.ScreenUpdating = False
   With ActiveSheet
      If .FilterMode Then .ShowAllData
      der = .Cells(Rows.Count, "a").End(xlUp).Row
      t = Range("a2:a" & der).Value
      tmois = Split(Mois, ",")
      ReDim Preserve t(1 To UBound(t), 1 To 2)
      For i = 1 To UBound(t)
         x = Application.Trim(Replace(Replace(t(i, 1), """", ""), ".", ""))
         t(i, 1) = Empty
         s = Split(LCase(x))
         For k = LBound(tmois) To UBound(tmois)
            If s(1) Like tmois(k) & "*" Then Exit For
         Next k
         If k <= UBound(tmois) Then
            t(i, 1) = Format(DateSerial(s(2), k + 1, 1), "mmmm")
            t(i, 2) = Format(DateSerial(s(2), k + 1, 1), "yyyy")
         End If
      Next i
      .Range("b2:c" & Rows.Count).Clear
      .Range("b2:c2").Resize(UBound(t)) = t
   End With
   MsgBox Format((Timer - deb) * 1000, "#,##0\ millisec. pour ") & Format(UBound(t), "#,##0 lignes traitées")
End Sub

 

[Rabeto]

Bonjour mapomme,

Merci beaucoup, c'est exactement comme ça, en plus vous avez rajouté quelques choses que j'ai toujours cherché (le timing MsgBox) c'est super

Merci infiniment

 

[job75]

Bonjour Rabeto, mapomme, le forum,

A priori il s'agit d'une simple conversion, c'est très simple :

Sub Convertir()
Dim tablo, i&, dat
With [A1].CurrentRegion.Resize(, 2)
    tablo = .Value
    For i = 2 To UBound(tablo)
        dat = Mid(tablo(i, 1), 2)
        If IsDate(dat) Then tablo(i, 2) = CDate(dat) Else tablo(i, 2) = ""
    Next
    .Value = tablo
    .Columns(3).Offset(1) = .Columns(2).Offset(1).Value 'copie les valeurs
    .Columns(2).NumberFormat = "mmmm"
    .Columns(3).NumberFormat = "yyyy"
End With
End Sub

A+

 

[job75]

Au post #1 vous parlez de formules alors voyez cette macro :

Sub Convertir2()
With [A1].CurrentRegion
    If .Rows.Count = 1 Then Exit Sub
    With .Rows(2).Resize(.Rows.Count - 1)
        .Columns(2) = "=TEXT(MID(A2,2,LEN(A2)-7),""mmmm"")"
        .Columns(3) = "=--RIGHT(A2,4)"
    End With
End With
End Sub

Sur 100 000 lignes elle s'exécute en 0,27 seconde contre 0,92 seconde pour celle du post #4.

 

[Rabeto]

Bonjour job75;

J'ai été toujours impressionné par vos réponses et l'efficacité de vos macros,

merci infiniment,