Sub Bilan()
Dim MesFichiers, X, N, Nfic
Dim Fin As Long, Trouve As Range
Dim oldStatusBar
Application.ScreenUpdating = False
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Début traitement"
' on efface ou non les données de synthèse (possibilité de faire
' la synthèse en plusieurs fois ou de rajouter des fichiers
' chaque jour.
If MsgBox("Voulez-vous effacer la précédente synthèse ?", _
vbYesNo + vbDefaultButton1) = vbYes Then
If MsgBox("Êtes vous certain de vouloir effacer la précédente synthèse ?", _
vbYesNo + vbDefaultButton1) = vbYes Then
Sheets("Synthese").Range("A:D").ClearContents
End If
End If
' boucle de sélection des fichiers et de traitement
Do
' Sélection des fichiers csv
MesFichiers = Application.GetOpenFilename( _
FileFilter:="Fichier CSV (*.csv), *.txt,Tous fichiers (*.*), *.*", _
FilterIndex:=1, Title:="Sélection fichiers (test)", MultiSelect:=True)
If VarType(MesFichiers) = vbBoolean Then
' aucun fichier sélectionné!
MsgBox "aucun fichier choisi"
Else
' un ou plusieurs fichiers choisis -> on traite
Nfic = UBound(MesFichiers) - LBound(MesFichiers) + 1
N = 0
MsgBox Nfic & " fichier(s) choisi(s)"
For Each X In MesFichiers
N = N + 1
' traitement de chacun des fichiers sélectionnés
' ouverture du fichier
Workbooks.Open Filename:=X
With ActiveSheet
' Convertir les données
.Columns("A:A").TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlTextQualifierNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
'Nettoyage du fichier
' on ôte les lignes non = à 1..24, non = à A1..A24 et ne commençant pas "Trk"
Fin = .Range("A" & Rows.Count).End(xlUp).Row
.Range("D:D").Clear
.Range("D1").FormulaArray = _
"=SUM(COUNTIF(RC[-3],""A""&ROW(R1:R24))+COUNTIF(RC[-3],ROW(R1:R24))+" & _
"COUNTIF(RC[-3],""Trk"" & ROW(R1:R24))) > 0"
.Range("D1").Copy .Range("D2:D" & Fin)
.Range("A1:D" & Fin).Sort key1:=.Range("D:D"), order1:=xlDescending, Header:=xlNo
Set Trouve = Nothing
Set Trouve = .Range("A1:D" & Fin).Find(what:=False, LookIn:=xlValues, lookat:=xlWhole)
If Not Trouve Is Nothing Then .Range("A" & Trouve.Row & ":D" & .Rows.Count).Delete
.Range("D:D").Clear
' on calcule le nombre de jour -> colonne C / 86400000
Fin = .Range("A" & Rows.Count).End(xlUp).Row
.Range("D1").Formula = "=C1 / 86400000"
.Range("D1").Copy .Range("D1:D" & Fin)
.Range("D1:D" & Fin).Value = .Range("D1:D" & Fin).Value
.Range("D1:D" & Fin).Copy .Range("C1")
' on copie les colonne A à C à la fin des données de la feuille "Synthese"
Set Trouve = ThisWorkbook.Sheets("Synthese").Range("A" & Rows.Count).End(xlUp)
Set Trouve = Trouve.Offset(IIf(Trouve <> "", 1, 0))
.Range("A1:C" & Fin).Copy Trouve
End With
Application.StatusBar = N & " fichiers traités / " & Nfic
ActiveWindow.Close SaveChanges:=False
' on passe au fichier suivant
Next X
End If
' on arrête ou continue
Loop Until MsgBox("Autres fichiers à traiter?", vbYesNo + vbDefaultButton1) = vbNo
Application.ScreenUpdating = True
Application.StatusBar = ""
oldStatusBar = Application.DisplayStatusBar
End Sub
