Discussion :

[arnaudTHE]

Bonjour à tous,

Voici un petit soucis auquel je suis confronté : l'extraction de dates dans des noms de fichiers qui varient.
J'ai sur une feuille Excel un listing de nom de fichiers en colonne A, je cherche à extraire des dates de ces noms dans les colonnes B (pour les mois si indiqué) et C (pour les années si indiqué)
Il peut soit y avoir simplement une année sous forme YY ou YYYY ou des mois couplés à des années type MMYY ou MMYYYY.

Ci-dessous un apperçu :
fichiertype_0912-new.xls (=>09 en colonne B et 12 en colonne C)
autrefichier 2012-division-1012-new.xls (=>10 en colonne B et 12 en colonne C)
fichierdifferent-equip-112012.zip (=>11 en colonne B et 12 ou 2012 en colonne C)
dernier-2011-0612.zip (=>06 en colonne B et 12en colonne C)

Vous allez vous dire que ce listing est très sale et vous avez raison.
Voilà le code que j'ai commencé à écrire, sauf que je n'arrive pas à garder le "zéro" du fichier "fichiertype_0912-new.xls" lorsque j'utilise la fonction "VAL" ligne XX

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub AnalyseFichiers()
Dim Nb As Byte
Dim i As Integer, j As Integer
Dim nbline As Long
Dim Nombre As Long
Dim Cible As String, Resultat As String
 
nbline = Sheets("liste").Cells(1000, 1).End(xlUp).Row
 
For i = 2 To nbline
    Cible = Cells(i, 1)
    For j = Len(Cible) To 1 Step -1
        If IsNumeric(Mid(Cible, j, 1)) Then
            Nombre = Val(Mid(Cible, j - 3, Len(Cible)))
            If Len(Nombre) = 4 Then
                Nombre = "0" & Nombre
                Cells(i, 8).NumberFormat = "@"
                Cells(i, 8) = "'" & Left(Nombre, 2)
                Cells(i, 9) = "'" & Right(Nombre, 2)
            End If
        End If
    Next j
Next i
End Sub

Si vous avez des idées sur ce sujet, je suis preneur!

[Daniel.C]

Bonjour,

Je n'ai pris en compte que les séparateurs "." et "-" de fin de date. S'il y en a d'autres, il faudra les ajouter.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub test()
Dim C As Range, Txt As String, Txt2 As String, I As Long, Teste As Boolean
For Each C In Range([A1], Cells(Rows.Count, 1).End(xlUp))
    Teste = False
    Txt2 = ""
    Txt = Replace(C.Value, ".", "\")
    Txt = Replace(Txt, "-", "\")
    For I = InStrRev(Txt, "\") To 1 Step -1
        If IsNumeric(Mid(Txt, I, 1)) Then
            Txt2 = Mid(Txt, I, 1) & Txt2
            Teste = True
        ElseIf Teste = True Then
            Exit For
        End If
    Next I
    If Len(Txt2) = 6 Then
        Cells(C.Row, 2) = CInt(Left(Txt2, 2))
        Cells(C.Row, 3) = CInt(Right(Txt2, 4))
    ElseIf Len(Txt2) = 4 Then
        Cells(C.Row, 2) = CInt(Left(Txt2, 2))
        Cells(C.Row, 3) = CInt(Right(Txt2, 2))
    End If
Next C
End Sub

NB. Pour conserver le "0" de "09", ajoute :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells(C.Row, 2).NumberFormat = "00"

en fin de macro.

[arnaudTHE]

Un grand merci Daniel.C pour ton code.
Il fonctionne bien!
De plus je le trouve très rapide!