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

Aimedija

XLDnaute Nouveau
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
 

Pièces jointes

  • Exemple extraction date vs texte.xlsm
    35.8 KB · Affichages: 32

Lone-wolf

XLDnaute Barbatruc
Bonjour Aimedija

@Aimedija

Est-ce que tu vois le fichier toi?? o_O

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? :rolleyes:
 

Aimedija

XLDnaute Nouveau
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.
 

Pièces jointes

  • Exemple extraction.xlsm
    19.6 KB · Affichages: 38

vgendron

XLDnaute Barbatruc
pour le cas des dates sans "/" ===> 01 06 2018 en supposant qu'il y aura TOUJOURS un "from " dans la cellule....
VB:
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

XLDnaute Nouveau
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 :
Code:
  .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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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
 

Pièces jointes

  • Exemple extraction date vs texte 2.xlsm
    6.7 MB · Affichages: 33

vgendron

XLDnaute Barbatruc
Hello

essaie cette macro
VB:
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
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG