Extraire le date d'une cellule avec le bon format

Bonjour à tous,

Dans un tableau excel que j'extrais depuis un logiciel interne de ma boite,

je dispose d'une colonne dans laquelle il me faut extraire la date vers une autre cellule.

Bien sur, j'ai vu d'autres sujets qui traitent de ce problème.

1er problème

Néanmoins, j'aimerais à partir de VBA que cette formule marche même si la date n'est plus au même endroit dans le corps de la cellule.

2nd problème

Le format utilisé dans mon tableau est de la forme "jj/mm", la traduction est automatiquement "mm/jj" ce qui fausse la date

voici le bout de code

Sub test_1()

For x = 1 To 9
'i = 1

        'Jack = InStr(Cells(x, 5), y)
        If Cells(x, 5).Value Like "*cpty short*" Then
        y = Right(Cells(x, 5).Value, 5)
        Cells(x, 6).Value = y
        Cells(x, 6).NumberFormat = "mm/dd/yy"

        'Set Cells(x, 6).Format = "dd.mm.yy"

        'i = i + 1
        End If

Next x

End Sub

le résultat si la cellule contient "relance mail cpty short 02/04" ( le 2 avril) sera "02/04/19"

le résultat si la cellule contient "relance mail cpty short 28/04" ( le 2 avril) sera "28/04"

donc un petit problème de format

Si vous avez des conseils/idées je suis preneur.

Bien à vous et merci !

Bonjour, à essayer

Sub melch()

For i = 1 To 9

    If InStr(Cells(i, 5), "/") > 1 Then
        jour = Mid(Cells(i, 5), InStr(Cells(i, 5), "/") - 2, 2)
        mois = Mid(Cells(i, 5), InStr(Cells(i, 5), "/") + 1, 2)
        Cells(i, 6) = DateSerial(Year(Now), mois, jour)
    End If
Next

End Sub

Bonjour Skizobar !

Pas évident sans un fichier "exemple" de comprendre exactement le souci avec les dates.

Néanmoins j'ai bidouillé un peu avec les explications que tu as donné, essaie ce code et dis-nous si ça solutionne ton 2ème problème

Sub test_1()

For x = 1 To 9
'i = 1      

        'Jack = InStr(Cells(x, 5), y)
        If Cells(x, 5).Value Like "*cpty short*" Then
        y = Right(Cells(x, 5).Value, 5)

        Cells(x, 6).Value = CDate(y)
        Cells(x, 6).NumberFormat = "dd/mm/yy"

        'Set Cells(x, 6).Format = "dd.mm.yy"

        'i = i + 1
        End If

Next x

End Sub

Bonjour,

Voici un code avec deux fonctions dont une qui retourne un tableau. Cette dernière peut être utiliser directement dans Excel en matricielle (en ligne). Pour l'appel par la Sub "Test()", le résultat est dans la fenêtre d'exécution (Ctrl+G dans le VBE) :

Sub Test()

    Dim Tbl() As Date
    Dim Plage As Range
    Dim I As Long

    Set Plage = DefPlage(ActiveSheet)

    Tbl = LesDates(Plage)

    If Not (Not Tbl()) Then

        For I = 1 To UBound(Tbl)

            'à voir ce que tu veux en faire !
            Debug.Print Tbl(I)
            'MsgBox Tbl(I)

        Next I

    End If

End Sub

Function LesDates(Plage As Range) As Date()

    Dim Tbl() As Date
    Dim Cel As Range
    Dim Jour As Integer
    Dim Mois As Integer
    Dim Annee As Integer
    Dim Pos As Integer
    Dim I As Long

    Annee = 2019

    For Each Cel In Plage

        If Cel.Value Like "*cpty short*/*" Then

            Pos = InStr(Cel.Value, "/")
            Jour = Mid(Cel.Value, Pos - 2, 2)
            Mois = Mid(Cel.Value, Pos + 2, 2)

            I = I + 1: ReDim Preserve Tbl(1 To I)
            Tbl(I) = DateSerial(Annee, Mois, Jour)

        End If

    Next Cel

    LesDates = Tbl()

End Function

Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range

    On Error GoTo Fin

    With Fe

        Set DefPlage = .Range(.Cells(L, C), _
                       .Cells(.Cells.Find("*", .[A1], -4123, , _
                       1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                       2, 2).Column))

    End With

    Exit Function

Fin:

    Set DefPlage = Nothing

End Function
Rechercher des sujets similaires à "extraire date bon format"