CDate plante à cause de la syntaxe du texte à convertir

Le 19/12/2015 à 17:27

Bonjour à tous !

Mon fichier Excel importe par VBA des dates/heures venant d'un autre logiciel, avec une syntaxe bien particulière.

Par exemple, une date comme le 12 avril 2015 à 16h00 est importée au format suivant : 12APR15/1600

J'ai besoin de convertir ce texte brut en une vraie date bien propre, exploitable par Excel... Du coup, j'ai du

faire chauffer mon cerveau car la fonction VBA "CDate" ne parvient pas à la convertir directement :

Sub formatdate()

Dim wiz As String
Dim dte As Date
Dim textedate As String

'Voici la date brute, telle qu'importée de mon logiciel nommé 'Wizard'.
wiz = "01FEB15/0820"

'Remplacement des 3 lettres du mois en anglais par un format numérique entre slashs

If Mid(wiz, 3, 3) = "JAN" Then wiz = Replace(wiz, "JAN", "/01/")
If Mid(wiz, 3, 3) = "FEB" Then wiz = Replace(wiz, "FEB", "/02/")
If Mid(wiz, 3, 3) = "MAR" Then wiz = Replace(wiz, "MAR", "/03/")
If Mid(wiz, 3, 3) = "APR" Then wiz = Replace(wiz, "APR", "/04/")
If Mid(wiz, 3, 3) = "MAY" Then wiz = Replace(wiz, "MAY", "/05/")
If Mid(wiz, 3, 3) = "JUN" Then wiz = Replace(wiz, "JUN", "/06/")
If Mid(wiz, 3, 3) = "JUL" Then wiz = Replace(wiz, "JUL", "/07/")
If Mid(wiz, 3, 3) = "AUG" Then wiz = Replace(wiz, "AUG", "/08/")
If Mid(wiz, 3, 3) = "SEP" Then wiz = Replace(wiz, "SEP", "/09/")
If Mid(wiz, 3, 3) = "OCT" Then wiz = Replace(wiz, "OCT", "/10/")
If Mid(wiz, 3, 3) = "NOV" Then wiz = Replace(wiz, "NOV", "/11/")
If Mid(wiz, 3, 3) = "DEC" Then wiz = Replace(wiz, "DEC", "/12/")

'Reformulation de la date brute pour que la fonction CDATE fonctionne + conversion
dte = CDate(Left(wiz, 8) & " " & Mid(wiz, 10, 2) & ":" & Right(wiz, 2))

MsgBox (dte)

End Sub

Ce code fonctionne, mais je le trouve particulièrement chargé pour pas grand chose.

Surtout en ce qui concerne la série de "IF" destinés à reformuler le mois...

Comme j'ai le nez dedans depuis un bon moment j'aimerai un avis extérieur pour savoir si on peut optimiser tout ça

Merci infiniment à tous !

Micka

Le 19/12/2015 à 18:06

Bonjour

mickado83 a écrit :

si on peut optimiser tout ça

Optimiser vitesse et/ou code ?

Déjà en utilisant If...ElseIf ..End If (ou Select Case .. End Select) tu pourrais gagner en rapidité (au minimum 1 test - au maximum 12) car actuellement c'est toujours 12 tests

Une idée (qui fonctionne)

Sub test()
Dim wiz As String
Dim dte As Date

  'Voici la date brute, telle qu'importée de mon logiciel nommé 'Wizard'.
  wiz = "01FEB15/0820"

  'Remplacement des 3 lettres du mois en anglais par un format numérique entre slashs
  wiz = Left(wiz, 2) & "/" & Format(Application.Match(Mid(wiz, 3, 3), Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC"), 0), "00") & "/" & Mid(wiz, 6)

  'Reformulation de la date brute pour que la fonction CDATE fonctionne + conversion
  dte = CDate(Left(wiz, 8) & " " & Mid(wiz, 10, 2) & ":" & Right(wiz, 2))

  MsgBox (dte)
End Sub

1 inconvénient majeur : Si le texte est introuvable (erreur de frappe) --> un test de la valeur retournée

Le 19/12/2015 à 18:28

Bonjour,

Une autre manière :

Sub formatdate()

    Dim wiz As String
    Dim Jour As Integer
    Dim Mois As Integer
    Dim Annee As Integer
    Dim I As Integer

    'Voici la date brute, telle qu'importée de mon logiciel nommé 'Wizard'.
    wiz = "25SEP15/0820"

    For I = 1 To 12
        If Mid(wiz, 3, 3) = Choose(I, "JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC") Then Mois = I: Exit For
    Next I

    MsgBox CDate(DateSerial(Right(Split(wiz, "/")(0), 2), Mois, Left(wiz, 2)) & " " & TimeSerial(Left(Split(wiz, "/")(1), 2), Right(Split(wiz, "/")(1), 2), 0))

End Sub
Le 19/12/2015 à 18:53

Merci à tous les 2 !

Grâce à vous, j'ai déjà deux possibilités bien plus abouties que mes IF successifs... Je ne connais pas bien les fonctions

Choose, Match et Array... Donc Je vais étudier un peu leur fonctionnement, pour voir laquelle est plus adaptée à mon cas !

1 inconvénient majeur : Si le texte est introuvable (erreur de frappe) --> un test de la valeur retournée

Cette chaîne de texte est générée par mon logiciel, ce n'est pas une saisie manuelle... Donc pas de faute possible !

Pour aller plus loin, question à 2 balles :

Au lieu de saucissonner et transformer le texte comme on le fait ici, pour que Cdate puisse fonctionner, ne peut on pas, à l'inverse, aider la fonction Cdate en lui déclarant en amont, la syntaxe du texte brut qu'on lui soumet ? A savoir lui indiquer que le texte à convertir est à ce format là : "JJMMMAA/HHNN"

Le 20/12/2015 à 12:36

Bonjour,

Ta date (ton texte) extrait de ton logiciel ne sera jamais reconnue en tant que date par Excel.

Nous sommes dans l'obligation d'utiliser des artifices pour transcrire ton texte en date, reconnue par Excel.

Cdlt.

Option Explicit
Option Base 1

Public Sub DEMO()
Dim wiz As String
Dim tbl, arrMonths
Dim dtTime As Date, dt
Dim iDay As Integer, iYear As Integer, iMonth As Integer
Dim I As Long

    wiz = "25SEP15/0820"

    tbl = Split(wiz, "/")
    arrMonths = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")

    iYear = 2000 + Right(tbl(0), 2)
    iDay = Left(tbl(0), 2)
    dtTime = TimeSerial(Left(tbl(1), 2), Right(tbl(1), 2), 0)

    For I = 1 To 12
        If Mid(wiz, 3, 3) = arrMonths(I) Then
            iMonth = I
            Exit For
        End If
    Next I

    dt = DateSerial(iYear, iMonth, iDay) + dtTime
    MsgBox "Date : " & dt

    dt = Format(dt, "ddmmmyyyy/hhmm")
    MsgBox "Date (texte) : " & dt

End Sub
Le 21/12/2015 à 10:59

Bonjour,

ma contribution:

Option Explicit
Sub Transformerlesdates2()
Dim mDate As String
Dim mDay As String
Dim mYear As String
Dim Mmonth As String
Dim Last
Dim Newdate As Date
  mDate = "01APR15/0820"
  mDay = Left(mDate, 2):  mYear = Mid(mDate, 6, 2):  Mmonth = Mid(mDate, 3, 3)
  Last = Split(mDate, "/")
  Mmonth = Switch(Mmonth = "JAN", 1, Mmonth = "FEB", 2, Mmonth = "MAR", 3, Mmonth = "APR", 4, Mmonth = "MAY", 5, Mmonth = "JUN", 6, _
                  Mmonth = "JUL", 7, Mmonth = "AUG", 8, Mmonth = "SEP", 9, Mmonth = "OCT", 10, Mmonth = "NOV", 11, Mmonth = "DEC", 12)
  Newdate = DateSerial(mYear, Mmonth, mDay)
  MsgBox (mDay & "/" & Mmonth & "/" & mYear & Chr(13) & "   " & Chr(13) & Newdate)
End Sub
Le 21/12/2015 à 18:36

Au top ! Merci encore à chacun d'entre vous, pour toutes ces options possibles !

Je passe le sujet en "Résolu", je pense avoir de quoi m'en sortir avec tout ça

Rechercher des sujets similaires à "cdate plante cause syntaxe texte convertir"