Import données csv et format de dates

Le 12/03/2018 à 16:29

Salut,

J'ai un fichier source au format csv, et j'ai un soucis : la moitié des dates semblent au format texte, pourtant lorsque je double-clique dessus et fait Entrée elles se mettent au format demandé.

En attendant ça fout le bazar dans mon tri de cellules.

Ci-joint le code ci-dessous accompagné du fichier source. Le code (tout bête); sert à répartir les dates par années (une année par page), arrondir les heures et trier par date puis heure.

Option Explicit
Sub MaJ()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim chemin$, nomclass$, nomfeuille$, i&, derligne&, Base As Workbook, TabBase, annee$, debut, WS As Worksheet

    debut = Timer

    For Each WS In ThisWorkbook.Worksheets
        derligne = WS.Range("A" & Rows.Count).End(xlUp).Row
        WS.Range("A2:C" & derligne + 1).ClearContents
    Next WS

    chemin = ThisWorkbook.Path & "\"
    nomclass = Mid(ThisWorkbook.Name, 7) 'mes fichiers "macro" ont le même nom que le fichier source correspondant avec un ou deux mots (fixe) avant
    nomclass = Left(nomclass, Len(nomclass) - 4) & "csv" 'on vire le "xlsm" et on met l'extension du fichier source
    nomfeuille = Left(nomclass, Len(nomclass) - 4) 'l'unique feuille du .csv a le nom du fichier snas l'extension

    Set Base = Workbooks.Open(chemin & nomclass, ReadOnly:=True, Local:=False)

    With Base.Sheets(nomfeuille)
        derligne = .Range("A" & Rows.Count).End(xlUp).Row
        TabBase = .Range("A1:C" & derligne).Value
    End With
    Base.Close

    With ThisWorkbook
        For i = 2 To UBound(TabBase, 1)
            annee = Year(TabBase(i, 1))
            derligne = .Sheets(annee).Range("A" & Rows.Count).End(xlUp).Row

            If Minute(TabBase(i, 2)) >= 30 Then
                If Hour(TabBase(i, 2)) < 23 Then
                    .Sheets(annee).Cells(derligne + 1, 1).Value = Hour(TabBase(i, 2)) + 1 & ":00:00"
                ElseIf Hour(TabBase(i, 2)) = 23 Then
                    .Sheets(annee).Cells(derligne + 1, 1).Value = "00:00:00"
                    .Sheets(annee).Cells(derligne + 1, 2).Value = DateAdd("d", 1, TabBase(i, 1))
                    .Sheets(annee).Cells(derligne + 1, 2).Interior.ColorIndex = 6
                End If
            Else
                .Sheets(annee).Cells(derligne + 1, 1).Value = Hour(TabBase(i, 2)) & ":00:00"
            End If

            .Sheets(annee).Cells(derligne + 1, 2).Value = TabBase(i, 1)
            .Sheets(annee).Cells(derligne + 1, 3).Value = TabBase(i, 3)
        Next i
        Calculate
        For Each WS In ThisWorkbook.Worksheets
            derligne = WS.Range("A" & Rows.Count).End(xlUp).Row
            WS.Range(WS.Cells(1, 2), WS.Cells(derligne, 2)).NumberFormat = "0"
            WS.Range(WS.Cells(1, 1), WS.Cells(derligne, 3)).Sort Key1:=WS.Range("B1"), Order1:=xlAscending, DataOption1:=xlSortTextAsNumbers, Header:=True
            WS.Range(WS.Cells(1, 2), WS.Cells(derligne, 2)).NumberFormat = "dd/mm/yy;@"
        Next WS
    End With
    Calculate
        ThisWorkbook.save
    MsgBox ("Mise à jour effectuée en " & Timer - debut & " secondes.")

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Une idée de comment je peux "forcer" les cellules récalcitrantes à rentrer dans le rang ?
11test-source-copie.zip (111.88 Ko)
Le 12/03/2018 à 17:06

Bonjour,

Kit a écrit :

Une idée de comment je peux "forcer" les cellules récalcitrantes à rentrer dans le rang ?

le problème, c'est que les cellules "dans le rang" sont fausses car le mois est à la place du jour et vice versa !!

il faut importer en texte soit avec format soit en ajoutant une apostrophe devant

je regarde

Le 12/03/2018 à 17:14

exemple simplifié

14import-csv-date.xlsm (514.79 Ko)
Le 12/03/2018 à 17:18

Bonjour

voila une autre macro

a toi de choisir

A+

Maurice

Sub ChoixFicCsv()
Dim dossier As FileDialog
ChoixChemin = ActiveWorkbook.Path & Application.PathSeparator
   Set dossier = Application.FileDialog(msoFileDialogFilePicker)
      With dossier
         .AllowMultiSelect = False
         .InitialFileName = ChoixChemin
         .Title = "Choix d'un fichier CSV"
         .Filters.Clear
         .Filters.Add "Fichier Csv ", "*.csv*", 1
            If .Show = -1 Then
               Chemin = .SelectedItems(1)
               LireMan Chemin
            End If
      End With
   Set dossier = Nothing
End Sub

Sub LireMan(NomFichier)
Dim Ar() As String
   With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlManual
   End With
Rows("1:" & Rows.Count).ClearContents
Sep = ","
Lig = 1
' -----------------------------------------
On Error Resume Next
   Open NomFichier For Input As #1
        Do While Not EOF(1)
            Line Input #1, Chaine
               Ar = Split(Chaine, Sep)
               Col = 1
                  For X = LBound(Ar) To UBound(Ar)
                    Select Case Col
                        Case 1
                            Cells(Lig, Col).Value = CDate(Ar(X))
                        Case Else
                            Cells(Lig, Col).Value = Application.Trim(CStr(Ar(X)))
                     End Select
                     Col = Col + 1
                  Next
            Lig = Lig + 1
        Loop
    Close #1
' -----------------------------------------
   With Application
      .ScreenUpdating = True
      .Calculation = xlCalculationAutomatic
      .EnableEvents = True
      .CutCopyMode = False
      .Goto [A1], True
   End With
End Sub
Le 13/03/2018 à 10:40

Merci messieurs

@Steelson : Je découvre plein de trucs (iif, Line Input, Freefile, EOF). J'ai par contre du mal à comprendre la ligne de remplacement (Cells(i,j+1...).

Si je comprends bien :

Si j = 0 (donc première colonne), alors on ajoute une apostrophe, sinon rien. Par contre sur le replace j'ai du mal à comprendre, notamment comment il va placer l'info dans la 4eme colonne.

@archer : Pareil, plein de nouvelles notions

Quelle est l'utilité d'application.trim (que je découvre) ici ? Idem pour Cstr.

Le 13/03/2018 à 11:14
Kit a écrit :

Si j = 0 (donc première colonne), alors on ajoute une apostrophe

pour transformer la valeur en texte

Kit a écrit :

sur le replace j'ai du mal à comprendre

oublie, aucun intérêt ici

            Cells(i, j + 1).Value = IIf(j = 0, "'", "") & Table(j)
Kit a écrit :

comment il va placer l'info dans la 4eme colonne.

formule excel

=SI(A2="";"";CNUM(A2))
Le 13/03/2018 à 13:55

Je cherchais bêtement une ligne de code pour la 4eme colonne

Merci !

Rechercher des sujets similaires à "import donnees csv format dates"