Extraire le date d'une cellule avec le bon format Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
S
Skizobar
Jeune membre
Jeune membre
Messages : 15
Inscrit le : 24 juillet 2019
Version d'Excel : 2016

Message par Skizobar » 4 septembre 2019, 16:24

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 !
m
melch
Membre dévoué
Membre dévoué
Messages : 592
Appréciations reçues : 27
Inscrit le : 28 juillet 2016
Version d'Excel : 2007 FR, 2013 FR

Message par melch » 4 septembre 2019, 16:39

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
Avatar du membre
Gaz0line
Membre dévoué
Membre dévoué
Messages : 566
Appréciations reçues : 3
Inscrit le : 28 juillet 2012
Version d'Excel : 2010 FR, 2013 FR
Téléchargements : Mes applications

Message par Gaz0line » 4 septembre 2019, 16:48

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
“La politesse coûte peu et achète tout.” - Montaigne
Pense à cliquer sur le bouton résolu si ton problème est résolu !
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 4'015
Appréciations reçues : 303
Inscrit le : 26 janvier 2011
Version d'Excel : 2007/2019

Message par Theze » 4 septembre 2019, 17:31

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
Il vaut mieux un qui sait que cent qui cherchent :wink:

Ce forum étant un lieu de partage, je n'accepte pas les messages privés !
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message