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