Portion de code ralentissant beaucoup le temps d'exécution
Bonjour au forum,
Ce code me permet de convertir des données d'un fichier texte (.txt) vers un fichier .xlsx.
Fichier = Application.GetOpenFilename '("Fichiers faux XLS, *.XLS")
If Fichier = False Then Exit Sub
'-----------------------------------------------------------------------------------------------------------------------
n = FreeFile
Open Fichier For Input As #n 'ouvre de façon classique le fichier en texte
'-----------------------------------------------------------------------------------------------------------------------
i = 1 ' ligne début
flagDate = False 'est mis à false au début pour éviter d'appliquer la transformation de la date à la ligne d'en-tête, dès l'en-tête stocké, il est mis à true pour toutes les autres lignes
Set xl = CreateObject("Excel.Application")
xl.SheetsInNewWorkbook = 1
Set wb = xl.Workbooks.Add
'-----------------------------------------------------------------------------------------------------------------------
USFChoix.Show
With wb.Sheets(1)
Do While Not EOF(1) 'Tant que je ne suis pas à la fin (EndOfFile)
Line Input #n, Contenu ', je lis le Contenu ligne par ligne ce qui est tout à fait classique aussi sur les fichiers texte
tbl = Split(Contenu, Chr(9)) 'permet de stocker les données d'une ligne du fichier texte dans un tableau
.Cells(i, 1).Resize(1, UBound(tbl) + 1) = tbl 'et le reporter en l'état sur une ligne excel
.Cells(i, 28).Value = Choix
If flagDate Then ' sup à la première ligne
.Cells(i, 1).Value = DateSerial(Mid(.Cells(i, 1).Value, 7, 4), Mid(.Cells(i, 1).Value, 4, 2), Mid(.Cells(i, 1).Value, 1, 2)) 'sauf que la première valeur ne donne pas la bonne date, on va alors reprendre cette valeur (ligne i, colonne 1) et lui appliquer ceci
.Cells(i, 1).NumberFormat = "dd.mm.yyyy"
.Cells(i, 2).NumberFormat = "@"
.Cells(i, 3).NumberFormat = "@"
.Cells(i, 4).Value = .Cells(i, 4).Value * 1
.Cells(i, 4).NumberFormat = "0.00"
.Cells(i, 5).Value = .Cells(i, 5).Value * 1
.Cells(i, 5).NumberFormat = "0.00"
.Cells(i, 6).Value = .Cells(i, 6).Value * 1
.Cells(i, 6).NumberFormat = "0.00"
.Cells(i, 7).NumberFormat = "@"
.Cells(i, 8).NumberFormat = "@"
.Cells(i, 9).NumberFormat = "@"
.Cells(i, 10).NumberFormat = "@"
'.Cells(i, 11).Value = DateSerial(Mid(.Cells(i, 11).Value, 7, 4), Mid(.Cells(i, 11).Value, 4, 2), Mid(.Cells(i, 11).Value, 1, 2))
.Cells(i, 11).NumberFormat = "dd.mm.yyyy"
.Cells(i, 12).NumberFormat = "@"
.Cells(i, 13).NumberFormat = "@"
.Cells(i, 14).NumberFormat = "@"
.Cells(i, 15).NumberFormat = "@"
.Cells(i, 16).NumberFormat = "@"
.Cells(i, 17).NumberFormat = "@"
.Cells(i, 18).NumberFormat = "@"
.Cells(i, 19).NumberFormat = "@"
.Cells(i, 20).NumberFormat = "@"
.Cells(i, 21).NumberFormat = "@"
.Cells(i, 22).NumberFormat = "@"
.Cells(i, 23).NumberFormat = "@"
.Cells(i, 24).NumberFormat = "@"
.Cells(i, 25).NumberFormat = "@"
.Cells(i, 26).NumberFormat = "@"
.Cells(i, 27).NumberFormat = "@"
.Cells(i, 28).NumberFormat = "@"
End If
i = i + 1
flagDate = True
Loop
End With
'-----------------------------------------------------------------------------------------------------------------------
Close #n
'-----------------------------------------------------------------------------------------------------------------------
wb.SaveAs Filename:="Blabla\" & "Extraction_" & Choix & "_" & Format(Date, "yyyy.mm.dd") & ".xlsx"
Set wb = Nothing
xl.Quit
Set xl = Nothing
Mon problème vient de la portion me permettant d'appliquer le format sur les cellules, à partir de :
If flagDate Then
Le temps d'exécution est assez long (j'ai environ 4000 lignes à traiter...).
Quelle autre syntaxe ou manière d'aborder cette mise en forme serait plus rapide ?
Merci d'avance !
Placer au début de vottre macro
Sub turns_off_applications()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayStatusBar = False
.EnableEvents = False
End With
End Sub
Placer à la fin
Sub turns_on_applications()
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayStatusBar = True
.EnableEvents = True
End With
End Sub
Bonjour PierFran,
Merci pour la réponse.
J'ai déjà ces fonctions en début en fin de code, je ne l'avais pas précisé désolé...
Peut-être ceci pourrait aidé un peu à partir de : .Cells(i, 12).NumberFormat = "@"
ou remplacer toutes lignes dont seulement le numéro de colonne change
for j = 12 to 28
.cells(i,j).numberformat = "@"
next
Salut Nrev,
Salut PierFran,
applique le traitement en une fois en début ou fin de boucle.
Columns("L").NumberFormat = "dd.mm.yyyy"
A+