XL 2019 Inversion date avec macro import

[Arnaud59000]

Bonjour tout le monde.

Je vers vers vous, j'ai un petit problème avec ma macro (ci dessous)

Sub PA()

Dim Fichier As String

'Acceleration du traitement des données
Application.ScreenUpdating = False

'Ouverture fenêtre de selection du fichier d'entrée
Fichier = Application.GetOpenFilename

Workbooks.Open Filename:=Fichier

'supprime le chemin
Fichier = Dir(Fichier)

'Copie données fichier d'entrée vers fichier de sortie
Workbooks("Suivi TimeSheet").Sheets("BDD PA").Range("A1:T5000").Value = Workbooks(Fichier).Sheets(1).Range("A1:T5000").Value

'Fermeture du classeur
ActiveWorkbook.Close

'Message
MsgBox "Import terminé"
End Sub


Cette macro me permet d'importer des données d'un fichier source vers mon fichier que je souhaite.
Cependant, lorsque que je sélectionne un fichier qui contient des dates (le fichier est initialement en CSV), je me retrouve avec des inversions dans mes dates.
Je m'explique :

Si le jour est inférieur à 12 alors j'ai une inversion entre mon jour et mon mois, alors que dans mes deux fichiers j'ai bien : JJ/MM/AAAA.
Cependant cela ne se passe pas lorsque je fais un collage spécial "uniquement les valeurs", Selection.PasteSpecial Paste:=xlPasteValues

Mais je n'arrive pas à inclure dans ma macro cette fonction (qui est aussi plus rapide que ma macro).

Avez-vous une solution ?

 

[Phil69970]

Bonjour @Arnaud COGEZ

Sur une astuce de Patrick
En supposant que les dates soient sur la colonne A

For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    Cells(i, 1) = Trim(Format(Cells(i, 1), "mm/dd/yyyy"))
Next i

*Merci de ton retour

@Phil69970

 

[Efgé]

Bonjour à tous
Une autre idée:

Workbooks("Suivi TimeSheet").Sheets("BDD PA").Range("A1:T5000").FormulaLocal = Workbooks(Fichier).Sheets(1).Range("A1:T5000").Value

Cordialement

 

[patricktoulon]

Bonjour à tous

'Copie données fichier d'entrée vers fichier de sortie
Workbooks("Suivi TimeSheet").Sheets("BDD PA").Range("A1:T5000").Value = Workbooks(Fichier).Sheets(1).Range("A1:T5000").Value

là perso j'ai un souci avec ça
si le value du fichier source est correcte il ne devrait pas y avoir de reformatage
quand on copie un .value vers un .value la valeur garde son format

ce qui veut dire que dans ton "fichier" (la source) les dates sont inversées et reformatées en FR
Attention je parle bien du value pas de ce que l'on vois dans la feuille
je soupçonne donc que dans ton fichier source les dates soient du string reformatées
c'est dangereux de jouer a ce genre de rattrapage
par exemple si 05/04/2021 est une bonne date en value et affichée mon astuce va l'inverser sans distinction

conclusion revois D'ABORDS TON FICHIER SOURCE
@+

 

[Arnaud59000]

Bonjour à tous

'Copie données fichier d'entrée vers fichier de sortie
Workbooks("Suivi TimeSheet").Sheets("BDD PA").Range("A1:T5000").Value = Workbooks(Fichier).Sheets(1).Range("A1:T5000").Value

là perso j'ai un souci avec ça
si le value du fichier source est correcte il ne devrait pas y avoir de reformatage
quand on copie un .value vers un .value la valeur garde son format

ce qui veut dire que dans ton "fichier" (la source) les dates sont inversées et reformatées en FR
Attention je parle bien du value pas de ce que l'on vois dans la feuille
je soupçonne donc que dans ton fichier source les dates soient du string reformatées
c'est dangereux de jouer a ce genre de rattrapage
par exemple si 05/04/2021 est une bonne date en value et affichée mon astuce va l'inverser sans distinction

conclusion revois D'ABORDS TON FICHIER SOURCE
@+

Bonjour @patricktoulon en P.J. le fichier initial anonymisé

Je test dans la foulée les solutions proposées

 

[Dranreb]

Bonjour.
Essayez comme ça :

Sub PA()
   Dim Fichier, WbkDon As Workbook, T(), L As Long

'Acceleration du traitement des données
   Application.ScreenUpdating = False

'Ouverture fenêtre de selection du fichier d'entrée
   Fichier = Application.GetOpenFilename
   If VarType(Fichier) <> vbString Then Exit Sub

'Ouverture du fichier
   Set WbkDon = Workbooks.Open(Filename:=Fichier)

'Copie données fichier d'entrée vers fichier de sortie
   T = WbkDon.Worksheets(1).Range("A1:T5000").Value
   For L = 2 To 5000
      If IsDate(T(L, 3)) And VarType(T(L, 3)) = vbString Then T(L, 3) = CDate(T(L, 3))
      Next L
ThisWorkbook.Worksheets("BDD PA").Range("A1:T5000").Value = T

'Fermeture du classeur
   WbkDon.Close

'Message
   MsgBox "Import terminé"
   End Sub

 

[patricktoulon]

re
bon ben c'est bien des dates FR alors dans ce xlx
alors c'est l'import
essaie de formater en " jj/mm/aaaa" des cellules de destination avant de copier les valeurs

 

[Phil69970]

Re

@patricktoulon

Tu confirmes ta propre astuce dit dans mon post #2

@Phil69970

 

[patricktoulon]

Bonjour @Phil69970 oui quand on importe en texte c'est ce qu'il faut faire
mais là il n'en est rien sa source est correctement formatée pour ces dates
tout du moins dans l'exemple qu'il a donné
donc le problème viens d'ailleurs
a mon avis comme je l'ai dit il importe plusieurs fois et ne clear pas la destination
je ne parlerais pas du code qui est en moins de 15 lignes un tas d'erreurs potentielles et meme une interprétation d'une fonction basique de vb erronée
donc
perso je ferais ceci avant de formater
avec l'exemple xlsx donné par le demandeur

Sub PA()

    Dim Fichier As String, WbK As Workbook

    'Acceleration du traitement des données
    Application.ScreenUpdating = False

    'Ouverture fenêtre de selection du fichier d'entrée
    Fichier = Application.GetOpenFilename
    'et si tu annule  alors on fait quoi ici hein !!!??? on ouvre un classeur sans nom?????? LOL!!!

    If Fichier <> "" Then
        Set WbK = Workbooks.Open(Filename:=Fichier)

        'Fichier = Dir(Fichier) 'supprime le chemin    ????? depuis quand dir supprime un fichier !!!!!!!!??????

        'Copie données fichier d'entrée vers fichier de sortie
        With ThisWorkbook.Sheets("BDD PA").Range("A1:T5000")
            .Clear    ' on clear tout valeur et format et tout et tout
            .Value = Workbooks(Fichier).Sheets(1).Range("A1:T5000").Value
        End With

        WbK.Close    'Fermeture du classeur

        'Message
        MsgBox "Import terminé"
    End If
End Sub

bien que getopenfilename je l'aurais un peu agrémenté de l’extension recherché histoire de ne pas me fair C.. a chercher dans l'explorateur de la fenetre

 

[Dranreb]

Remarque: le problème venait de ce que dans le fichier de données la colonne 3 contenait des textes qu'Excel reconnaissaient comme convertibles en dates mais toujours selon la règle anglo-saxonne quand c'est demandé par VBA. Il le faisait donc, quitte à interpréter quand même le premier champ devant '\' comme jour et le second comme mois si l'inverse normalement effectué ne marchait pas.
Le plus sûr c'est d'effectuer la conversion soi même à l'aide de la fonction CDate qui applique la règle locale.

 

[patricktoulon]

exact @Dranreb je l'ai vu après dans l'exemple xlsx il y a les deux format dans la colonne

on reviens donc a ce que j'ai dis toute a l'heure vérifier d'abords la source avant d'importer
là malheureusement on est obligé de boucler pour redresser
donc .value=.value on oublie ansi que le format magic d'ailleurs
bien mal parti ce projet pour 3 colonnes

 

[Arnaud59000]

Hello tout le monde !

Grande nouvelle, le DSI de ma boîte qui est à l'origine du fichier d'import a su modifier la sortie de la DBCentral pour en faire un fichier avec un seul format de date !

Fichier = Application.GetOpenFilename 'et si tu annule alors on fait quoi ici hein !!!??? on ouvre un classeur sans nom?????? LOL!!!

J'ai tout de même une question concernant cette réflexion, ca me permet d'ouvrir une fenetre windows et de choisir le fichier que je souhaite du moment qu'il est en fichier excel il y a un autre moyen de le faire plus rapide ?

N'ayant aucune formation "officielle" sur excel cette macro a été créée avec des bouts par ci par là de ce que j'ai pu trouver sur le net

 

[patricktoulon]

non si ce n'est en dur
au mieux tu précise quel type de fichier comme ça l'explorer sera moins fourni en proposition de fichier

Dim Fichier As Variant
Fichier = Application.GetOpenFilename(FileFilter:=" Excel Files ( *.xlsx;*.xlsm), ( *.xlsx*.xls), All Files, *.*", FilterIndex:=1)
If Fichier = False Then Exit Sub ' si tu annule
 'GO!!!

mille excuses j'ai corrigé

 

[patricktoulon]

et si tu es sur que ta source ne peut etre q'un "xlsx" tu le met en priorité

Dim Fichier As Variant
Fichier = Application.GetOpenFilename(FileFilter:=" Excel Files ( *.xlsx), ( *.xlsx), All Files, *.xlsx;*.xls;*.xlsm", FilterIndex:=1, Title:="explorer les fichers")
If Fichier = False Then Exit Sub ' si tu annule
 'GO!!!

la 2d option te montra tout les fichiers avec les extention excel

démonstration je n'ai qu'un seul ".xlsx" dans mon bureau

 

[Arnaud59000]

et si tu es sur que ta source ne peut etre q'un "xlsx" tu le met en priorité

Dim Fichier As Variant
Fichier = Application.GetOpenFilename(FileFilter:=" Excel Files ( *.xlsx), ( *.xlsx), All Files, *.xlsx;*.xls;*.xlsm", FilterIndex:=1, Title:="explorer les fichers")
If Fichier = False Then Exit Sub ' si tu annule
 'GO!!!

la 2d option te montra tout les fichiers avec les extention excel

démonstration je n'ai qu'un seul ".xlsx" dans mon bureau
Regarde la pièce jointe 1122655

C'est parfait merci bcp Patrick @patricktoulon