VBA excel comment differencier les dates du texte dans chaque cellule d'une colonne

[Aimedija]

Bonjour à tous,

Je viens vers vous afin résoudre un probléme assez complexe pour mon niveau dont je ne trouve pas la solution:

J'ai un fichier assez conséquent (plus de 65000 lignes) et je cherche à standardiser la colonne 35 avec seulement des dates (format mm/aaaa) . Celle-ci est composer de cellule contenant des dates avec du texte, au format standard.

Mon probléme est que j'aimerais extraire le contenue texte et que dans cette cellule seul la date reste présente.
la difficulté est que
1 . la date n'a pas toujours le même format, elles peux se présenter sous differentes formes comme par exemple ;
06/2018
Decembre 2017
05/09/2017
23 03 2018

2. Certaines cellule contiennent ses dates + une zone de texte ou des chiffres ou du texte + chiffres qui peuvent être devant ou derriére la date , avec ou sans séparateur (-).

3. il faut que le code n'efface pas ou ne modifie pas les cellules avec une date (seulement une date) déja présente.

Pourquoi je n'utilise pas la fonction excel Données > Convertir? Celle-ci modifie les autres cellules avec des dates.

Pourquoi je n'utile ^pas les fonctions excel STX, Droite ou Gauche? ces derniéres ne me permettent pas d'automatiser mon systéme et le fait de tiret ses formules altéres aussi les autres cellules.

merci de trouver ci-joint un fichier servant d'exemple,

merci d'avance

 

[Lone-wolf]

Bonjour Aimedija

@Aimedija

Est-ce que tu vois le fichier toi??

Sauvegarde le fichier sous un autre nom. Garde seulement 4 lignes, supprime le reste et enlève les données confidentielles.
Ensuite, ce n'est pas possible que tu aie 4 formats différents dans la colonne, je ne sais pas comment tu fait pour travailler ainsi; un format ça ne suffit pas?

 

[Aimedija]

Bonjour Lone-wolf,

Merci pour ton retour.

Malheuresement je reçois le rapport de prestataire de service sous cette forme avec des formats de dates variant. J'essaye de mettre un systéme au point pour ne pas devoir corriger manuellement chaque ligne et extraire uniquement la date dans les cellules.

Merci de trouver ci-joint le fichier rectifier selon ta demande.

 

[vgendron]

Hello

un début de réponse par macro


Hello @Lone-wolf
j'arrive après vos posts respectifs..
le fichier d'origine.. perso. je le voyais...??

 

[Lone-wolf]

Re

Désolé mais, ceci ne rentre pas dans mes compétences.

EDIT: Hi! vgendron

 

[vgendron]

pour le cas des dates sans "/" ===> 01 06 2018 en supposant qu'il y aura TOUJOURS un "from " dans la cellule....

Sub GarderDates()
Dim tablo() As Variant

With Sheets("Page1_1")
    tablo = .Range("AI2").Resize(.UsedRange.Rows.Count - 1).Value 'on met la colonne AI dans un tablo vba
    For i = LBound(tablo, 1) To UBound(tablo, 1) 'pour chaque ligne
        nbslash = Len(tablo(i, 1)) - Len(WorksheetFunction.Substitute(tablo(i, 1), "/", "")) 'compte le nombre de "/"
        If IsDate(tablo(i, 1)) Then 'si Excel détecte une date
            tablo(i, 1) = DateSerial(Year(tablo(i, 1)), Month(tablo(i, 1)), 1) 'on ne garde que le mois et année
           
        ElseIf nbslash <> 0 Then 'sinon, s'il y a des "/"
            pos1 = 0
            For j = 1 To nbslash
                pos1 = InStr(pos1 + 1, tablo(i, 1), "/")
                pos2 = InStr(pos1 + 1, tablo(i, 1), "/")
                If pos2 - pos1 = 3 Then 'si on a 2 "/" séparés de 3 caractères ==>  c'est une date complète
                    sousdate = Mid(tablo(i, 1), pos1 - 2, 12)
                Else 'sinon, il y a du texte entre les deux "/"
                    sousdate = Mid(tablo(i, 1), pos1 - 2, 7)
                End If
                If IsDate(sousdate) Then
                    tablo(i, 1) = DateSerial(Year(sousdate), Month(sousdate), 1)
                    Exit For
                End If
            Next j
        ElseIf InStr(1, tablo(i, 1), "from") <> 0 Then
             sousdate = Split(tablo(i, 1), "from ")(1)
             tablo(i, 1) = DateSerial(Year(sousdate), Month(sousdate), 1)
    ' MANQUE le cas des dates au format "Decembre 2018"
        Else
           tablo(i, 1) = tablo(i, 1)
        End If
       
    Next i

    .Range("AI2").Resize(UBound(tablo, 1)) = tablo
    .Range("AI2").Resize(UBound(tablo, 1)).NumberFormat = "mm/yyyy"
End With
End Sub

 

[Aimedija]

Bonjour Vgendron,

merci pour ton retour, ton code du post #4 est formidable, néanmoins lorsque je l'adapte à mon fichier (+ 65000 lignes) , je reçois un message d'erreur d'execution 1004 / erreur definie par l'objet ou par l'application à ce niveau :

  .range("AI2").Resize(UBound(tablo, 1)) = tablo
  .range("AI2").Resize(UBound(tablo, 1)).NumberFormat = "mm/yyyy"

J'ai pourtant copier ton module standard ? est ce le nombre de ligne qui fait défault?

Lone wolf,
un grand merci pour ton aide

 

[Lone-wolf]

Bonjour Lone-wolf,

Merci pour ton retour.

Malheuresement je reçois le rapport de prestataire de service sous cette forme avec des formats de dates variant. J'essaye de mettre un systéme au point pour ne pas devoir corriger manuellement chaque ligne et extraire uniquement la date dans les cellules.

Merci de trouver ci-joint le fichier rectifier selon ta demande.

@Aimedija : tu aurais dû le préciser, ça m'aurais évité de faire la remarque. Désolé.
Pour l'aide: moi je n'ai rien fait.

 

[Aimedija]

Lone-Wolf,
mes excuses j'aurais du le mentionner dés le départ.

Vgendron,

Oublie ma remarque du post #7, j'ai refait pas mal de test et cela fonctionne parfaitement.

Merci à vous deux pour l'intêret porté à ma requête.

 

[Aimedija]

Bonjour à tous,
Bonjour Vegedron,

je suis désolé de revenitr vers toi mais pourrais tu m'expliquer pourquoi dans certain cas le code bug au niveau du tablo , surtout lorsque j'insére des cellules vides?

Merci de trouver un nouveau fichier exemple ci-joint

 

[vgendron]

Hello

essaie cette macro

Sub GarderDates2()
Dim tablo() As Variant

With Sheets("Page1_1")
    .Range("AI2").Resize(.UsedRange.Rows.Count - 1).Select
    tablo = .Range("AI2").Resize(.UsedRange.Rows.Count - 1).Value2 'on met la colonne AI dans un tablo vba
    For i = LBound(tablo, 1) To UBound(tablo, 1) 'pour chaque ligne
        nbslash = Len(tablo(i, 1)) - Len(WorksheetFunction.Substitute(tablo(i, 1), "/", "")) 'compte le nombre de "/"
        If IsDate(tablo(i, 1)) Then 'si Excel détecte une date
            tablo(i, 1) = DateSerial(Year(tablo(i, 1)), Month(tablo(i, 1)), 1) 'on ne garde que le mois et année
           
        ElseIf nbslash <> 0 Then 'sinon, s'il y a des "/"
            pos1 = 0
            For j = 1 To nbslash
                pos1 = InStr(pos1 + 1, tablo(i, 1), "/")
                pos2 = InStr(pos1 + 1, tablo(i, 1), "/")
                If pos2 - pos1 = 3 Then 'si on a 2 "/" séparés de 3 caractères ==>  c'est une date complète
                    sousdate = Mid(tablo(i, 1), pos1 - 2, 12)
                Else 'sinon, il y a du texte entre les deux "/"
                    sousdate = Mid(tablo(i, 1), pos1 - 2, 7)
                End If
                If IsDate(sousdate) Then
                    tablo(i, 1) = DateSerial(Year(sousdate), Month(sousdate), 1)
                    Exit For
                End If
            Next j
        ElseIf InStr(1, tablo(i, 1), "from") <> 0 Then
             sousdate = Mid(Split(tablo(i, 1), "from ")(1), 1, 10)
             If IsDate(soudate) Then
                tablo(i, 1) = DateSerial(Year(sousdate), Month(sousdate), 1)
            Else
                tablo(i, 1) = tablo(i, 1)
            End If
    ' MANQUE le cas des dates au format "Decembre 2018"
        Else
           tablo(i, 1) = tablo(i, 1)
        End If
       
    Next i
    .Range("AI2").Resize(UBound(tablo, 1)).Value2 = tablo
    .Range("AI2").Resize(UBound(tablo, 1)).NumberFormat = "mm/yyyy"
End With
End Sub

 

[Aimedija]

Bonjour Vgendron,

Un tout grand merci pour ton temps , le code fonctionne enfin plus que parfaitement.
A noté que si on a une date telle que /2018 , il faut la retirer manuellement où le code va bloquer dessus.

Bien à toi,