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+