Macro
Bonjour à toutes et tous.
J'aimerai réalisé une macro qui me permet de transformer un fichier csv
00:00 4 6 7 8 9 15
01:00 6 7 8 9 10 20
en
00:00 4
00:10 6
00:20 7
00:30 8
00:40 9
00:50 15
01:00 6
01:10 7
01:20 8
01:30 9
01:40 10
01:50 20
Sub parserFichier()
Dim pctCompl As Single ' indice de progression de la barre de progression
' On fige la mise à jour de l'appli
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' On retient le nom du classeur courant
nomClasseur = ActiveWorkbook.Name
' On vide la feuille résultat
Sheets("Resultat").Activate
Cells.Select
Selection.ClearContents
' On affiche la feuille Resultat
Sheets("Resultat").Visible = True
' On s'assure d'être sur la feuille d'init
Sheets("Init").Activate
' On ouvre le fichier
Workbooks.OpenText Filename:=Range("D16"), _
DataType:=xlDelimited, Tab:=True, Local:=True
' On récupère la dernière ligne non vide
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row
' On initialise le compteur ligne du fichier résultat
compteur = 1
' On initialise la chaine GMT
UTC = ""
' On initialise le boolean dernier dimanche de mars ou d'octobre
isDernierDimanche = False
' On initiailise un compteur de rectification sur les heures d'octobre
cptHeuresOctobre = 18
' On initiailise un compteur de rectification sur les heures de mars
cptHeuresMars = 12
' On initiailise le compteur pour rectifier
cptDernierDim = 1
' On teste que le fichier texte commence par une date
If Not IsDate(Left(Range("A1"), 10)) Then
MsgBox ("Le fichier traité ne commence pas par une date.")
' fermeture de la fenêtre contenant la barre de progression une fois tous les traitements terminés
UserForm1.Hide
erreurFichier = 1
Exit Sub
End If
If Len(Range("A1")) >= 16 Then
' Si l'ouverture du fichier est dans une seule colonne
' On insère une colonne, on extrait la date et l'heure
' On colle les valeurs
' On met en forme en découpant l'unique chaine pour avoir les points dans des colonnes séparés
' On supprime la colonne B qui contient l'ancienne date, car vba ne gère pas bien
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[1],16)"
Range("A1").Select
Selection.AutoFill Destination:=Range("A1:A" & derniereLigne)
Range("A1:A" & derniereLigne).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(28, 1), Array(40, 1), Array(52, 1), _
Array(64, 1), Array(76, 1), Array(88, 1)), TrailingMinusNumbers:=True
Selection.Delete Shift:=xlToLeft
Else
' Si on détecte un point en H1, alors on a de grandes chances que la date et l'horodatage ne sont pas dans la même colonne
If Range("H1") <> "" Then
' Si la date et l'horodatage ne sont pas dans la même colonne
' On insère une colonne, on concatène la date et l'heure, on supprime les deux anciennes colonnes
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = _
"=TEXT(RC[1],""jj/mm/aaaa"")&"" ""&TEXT(RC[2],""hh:mm"")"
Range("A1").Select
Selection.AutoFill Destination:=Range("A1:A" & derniereLigne)
Range("A1:A" & derniereLigne).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:C").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Else
' La date et l'heure sont dans la même colonne
' On formate un coup car les secondes sont souvents ajoutées
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = _
"=TEXT(RC[1],""jj/mm/aaaa hh:mm"")"
Range("A1").Select
Selection.AutoFill Destination:=Range("A1:A" & derniereLigne)
Range("A1:A" & derniereLigne).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
End If
End If
' On init un compteur pour le nombre de boucle modulo
cptModulo = 0
' On parcourt et on parse
For Each c In Range("A1:A" & derniereLigne)
' si on clique sur la croix de la barre de chargement, on met total à -1 et on sort de la boucle
If Total = -1 Then
Exit For
End If
' itération et arrondi de l'index de progression de la barre de progression et lancement de la fonction "progress" pour mettre celle-ci à jour
pctCompl = Round((compteur / 7) / (derniereLigne / 100), 0)
progress pctCompl
' On récupère la date
chaineDate = c.Value
If CDbl(Month(Left(chaineDate, 10))) >= 4 And CDbl(Month(Left(chaineDate, 10))) <= 9 Then
' Si on est d'avril a septembre, alors UTC = + 0200
' Et on indique qu'on est pas le dernier dimanche pour éviter des effets de bords
UTC = " +0200"
isDernierDimanche = False
ElseIf CDbl(Month(Left(chaineDate, 10))) <= 2 Or CDbl(Month(Left(chaineDate, 10))) >= 11 Then
' Si on est de novembre a février, alors UTC = + 0100
' Et on indique qu'on est pas le dernier dimanche pour éviter des effets de bords
UTC = " +0100"
isDernierDimanche = False
ElseIf CDbl(Month(Left(chaineDate, 10))) = 3 Then
' Si on est au mois de mars
If CDbl(Weekday(CDate(Left(chaineDate, 10)))) = 1 And CDbl(Left(chaineDate, 2)) + 7 > 31 Then
' Si on est un dimanche et que c'est le dernier
' On change d'UTC et on indique qu'on est le dernier dimanche
UTC = " +0200"
isDernierDimanche = True
ElseIf Not isDernierDimanche Then
' Sinon si ce n'est pas le dernier dimanche, alors on change d'UTC et on réinit le compteur
UTC = " +0100"
cptDernierDim = 1
End If
ElseIf CDbl(Month(Left(chaineDate, 10))) = 10 Then
' Si on est au mois d'octobre
If CDbl(Weekday(CDate(Left(chaineDate, 10)))) = 1 And CDbl(Left(chaineDate, 2)) + 7 > 31 Then
' Si on est un dimanche et que c'est le dernier
' On change d'UTC et on indique qu'on est le dernier dimanche
UTC = " +0100"
isDernierDimanche = True
ElseIf Not isDernierDimanche Then
' Sinon si ce n'est pas le dernier dimanche, alors on change d'UTC et on réinit le compteur
UTC = " +0200"
cptDernierDim = 1
End If
End If
' On regarde si le compteur mod 7 est différent de 0
' Si c'est 0, on a traité tous les points d'une ligne
Do While compteur Mod 7 > 0
' On remplace la dizaine de minute du fichier source par le modulo du nombre de ligne par 7 moins 1
Workbooks(nomClasseur).Sheets("Resultat").Range("A" & compteur - cptModulo) = Replace(chaineDate, ":0", ":" & (compteur Mod 7) - 1) & UTC
' On recopie la valeur pour la dizaine ci-dessus
Workbooks(nomClasseur).Sheets("Resultat").Range("B" & compteur - cptModulo) = Cells(c.Row, (compteur Mod 7) + 1)
' Si on est un dimanche et que c'est le dernier d'octobre
If CDbl(Weekday(CDate(Left(chaineDate, 10)))) = 1 And isDernierDimanche And CDbl(Month(Left(chaineDate, 10))) = 10 Then
' Si le compteurDernierDim est <= cptHeuresOctobre
' => on compte jusqu'à la deuxième deuxième heure
If cptDernierDim <= cptHeuresOctobre Then
' On remplace l'UTC et on incrémente
Workbooks(nomClasseur).Sheets("Resultat").Range("A" & compteur - cptModulo) = Replace(Workbooks(nomClasseur).Sheets("Resultat").Range("A" & compteur - cptModulo), "+01", "+02")
cptDernierDim = cptDernierDim + 1
End If
' Idem qu'au dessus pour le mois de mars
ElseIf CDbl(Weekday(CDate(Left(chaineDate, 10)))) = 1 And isDernierDimanche And CDbl(Month(Left(chaineDate, 10))) = 3 Then
If cptDernierDim <= cptHeuresMars Then
Workbooks(nomClasseur).Sheets("Resultat").Range("A" & compteur - cptModulo) = Replace(Workbooks(nomClasseur).Sheets("Resultat").Range("A" & compteur - cptModulo), "+02", "+01")
cptDernierDim = cptDernierDim + 1
End If
Else
' Si on est pas le dernier dimanche, on réinit le compteur
cptDernierDim = 1
End If
' On incrémente le nombre de ligne pour le résultat
compteur = compteur + 1
Loop
' on incrémente un dernier coup la ligne
compteur = compteur + 1
' on incrémente le compteur de boucle modulo pour rectifier le compteur de ligne
cptModulo = cptModulo + 1
Next c
' On ferme le fichier
ActiveWorkbook.Close savechanges:=False
' On enlève les caractères bizarres
Sheets("Resultat").Activate
Columns("B:B").Select
Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Si on n'a pas fermé la fenêtre
If Total <> -1 Then
' fermeture de la fenêtre contenant la barre de progression une fois tous les traitements terminés
UserForm1.Hide
' On enregistre le fichier résultat
nom = Split(Sheets("Init").Range("D16"), "\")
nomTemp = nom(UBound(nom))
nomFichier = Sheets("Init").Range("D21") & Left(nomTemp, Len(nomTemp) - 4) & ".csv"
Application.DisplayAlerts = False
Range("A1").Columns.AutoFit
ThisWorkbook.ActiveSheet.Copy
With ActiveWorkbook
.SaveAs Filename:=nomFichier, FileFormat:=xlCSV, Local:=True
.Close
End With
End If
' On vide et cache la feuille Resultat
Sheets("Resultat").Activate
Cells.Select
Selection.ClearContents
Sheets("Resultat").Visible = False
' on remet les alertes excel
Application.DisplayAlerts = True
' On remet l'onglet init
Sheets("Init").Select
End Sub
J'ai ce bout de code mais qui ne fonctionne pas.
Bonjour Marions1857
Merci d'éditer ton message et de mettre le code entre les balises [code] et [ /code] sans espaces entre [ et /
A+