Problème récupérer le mois d'une date

Bonjour,

je précise que je ne maîtrise pas trop en vba mais j'essaye de bricoler

sur une grande plage de données (20000 lignes qui démarre à la ligne 5000) de 2 colonnes (R et S) date et mois , j'ai récupéré une date au format jjmmaa, que j'arrive rapidement à mettre au format jj/mm/aaaa en passant par un tableau vba par le code suivant :

Sub extraireValeursNumeriques_DansChaine()

    Dim chainedate, mois()
    Dim i, lig, DerLig As Long

  lig = 5000
  Do Until Sheets("DONNEES").Cells(lig, 1).Value = ""
  lig = lig + 1
  Loop
  DerLig = lig - 1

With Sheets("DONNEES")
    chainedate = .Range("R5000:S" & DerLig).Value

    For i = 1 To DerLig - 5000
    If Len(chainedate(i, 1)) = 5 Then

        chainedate(i, 1) = "0" & Mid(chainedate(i, 1), 1, 1) & "/" & Mid(chainedate(i, 1), 2, 2) & "/20" & Mid(chainedate(i, 1), 4, 2)
        chainedate(i, 2) = Month("0" & Mid(chainedate(i, 1), 1, 1) & "/" & Mid(chainedate(i, 1), 2, 2) & "/20" & Mid(chainedate(i, 1), 4, 2))

        Else
        chainedate(i, 1) = Mid(chainedate(i, 1), 1, 2) & "/" & Mid(chainedate(i, 1), 3, 2) & "/20" & Mid(chainedate(i, 1), 5, 2)
        chainedate(i, 2) = Month("0" & Mid(chainedate(i, 1), 1, 1) & "/" & Mid(chainedate(i, 1), 2, 2) & "/20" & Mid(chainedate(i, 1), 4, 2))

        End If
    Next
    .Range("R5000:S" & DerLig) = chainedate

End With

End Sub

en colonne 1, je récupère très bien la date sous le nouveau format, par contre en colonne 2 je ne récupère pas le mois.

j'ai l'erreur d'execution 13, incompatibilité de type.

j'ai essayé en créant un autre tableau mais ça ne fonctionne pas non plus.

Auriez vous une idée de ce qui cloche.

merci beaucoup pour votre aide

Bonjour,

Le fichier serait nécessaire pour le test et le conseil. Il y a surement une solution plus simple.

oui, désolé

voila

Re,

Essaye d'alléger ton fichier, car surement il dépasse 300 Ko autorisés.

ok, normalement là c'est bon

Bonjour,

Pour le principe.

Cdlt.

Public Sub extraireValeursNumeriques_DansChaine()
Dim ws As Worksheet
Dim a
Dim dt As Date
Dim i As Long, j As Long, lastRow As Long
Dim x As Byte

    Set ws = ActiveWorkbook.Worksheets("DONNEES")

    With ws

        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        a = .Range("A2:B" & lastRow).Value
        j = 0

        For i = 1 To UBound(a)
            If Len(a(i, 1)) = 5 Then x = 1 Else x = 2
            dt = CDate(Mid(a(i, 1), 1, x) & "/" & Mid(a(i, 1), x + 1, 2) & "/" & Right(a(i, 1), 2))
            a(i, 1) = dt
            a(i, 2) = Month(dt)
            j = j + 1
        Next

        .Range("G2").Resize(j, UBound(a, 2)) = a

    End With

    Set ws = Nothing

End Sub

Re,

Un code à essayer et à adapter :

Sub test()
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To DerLig
    If Len(Cells(i, 1)) = 5 Then
        jour = Left(Cells(i, 1), 1) * 1
        mois = Mid(Cells(i, 1), 2, 2) * 1
        annee = Right(Cells(i, 1), 2) * 1
    Else
        jour = Left(Cells(i, 1), 2) * 1
        mois = Mid(Cells(i, 1), 3, 2) * 1
        annee = Right(Cells(i, 1), 2) * 1
    End If
    Cells(i, 4) = DateSerial(annee, mois, jour)'pour la date
    Cells(i, 5) = Month(Cells(i, 4))'pour le mois
    Next i
End Sub

Bonjour,

merci beaucoup à tous les 2 de vous être pencher sur mon problème, j'ai utilisé le code de Jean-Eric cela fonctionne très bien.

à bientôt