Rangement des données anormalement long en vba

[fr832]

Bonjour à tous,

Une petite question j'utilise ce code ci-dessous afin de saisir des données dans une feuille excel,
ce dernier fonctionne normalement mais il est long pour s'exécuter environ 25 secondes, est-ce normal?

Le code

' Mise en place des valeurs saisies
  
With Sheets("Antipol")
    
    DerLigne = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        .Cells(DerLigne, 1) = Label_Fiche
        .Cells(DerLigne, 2) = Format(DTPicker1, "dd-mmm-yyyy")  'Format pour ne mettre que jj-mmm-aaaa
        .Cells(DerLigne, 3) = Format(TXT_1, "##:##")
        .Cells(DerLigne, 4) = Format(TXT_2, "##:##")
        .Cells(DerLigne, 5).FormulaR1C1 = "=RC[-1]-RC[-2]"
        .Cells(DerLigne, 6) = UCase(TXT_11) 'ucase pour mettre en majuscule
        .Cells(DerLigne, 7) = Combo_1
        .Cells(DerLigne, 8) = Val(TXT_3) 'Val permet de convertir les données en format numérique
        If Me.TXT_4 = "" Then .Cells(DerLigne, 9) = "" Else .Cells(DerLigne, 9) = CDbl(Me.TXT_4)
        .Cells(DerLigne, 10) = Combo_2
        .Cells(DerLigne, 11) = Format(TXT_5, "##:##")
        .Cells(DerLigne, 12) = Format(TXT_6, "##:##")
        .Cells(DerLigne, 13) = Combo_3
        If Me.TXT_7 = "" Then .Cells(DerLigne, 14) = "" Else .Cells(DerLigne, 14) = CDbl(Me.TXT_7) 'ce code permet de pauser la condition si vide on met rien sinon on efectue la saisie cela afin d'éviter un 0 lorsqu'il n'y a pas de données dans la textbox
        If Me.TXT_8 = "" Then .Cells(DerLigne, 15) = "" Else .Cells(DerLigne, 15) = CDbl(Me.TXT_8)
        If Me.TXT_9 = "" Then .Cells(DerLigne, 16) = "" Else .Cells(DerLigne, 16) = CDbl(Me.TXT_9)
        .Cells(DerLigne, 17) = Combo_4
        .Cells(DerLigne, 18) = Txt_10
        .Cells(DerLigne, 20).FormulaR1C1 = "=MONTH(RC[-18])"
        .Cells(DerLigne, 21).FormulaR1C1 = "=YEAR(RC[-19])"
  
End With
    
 'Appel la mise en forme
 Call mefcAntipol
    
    
'Ferme l'userform
Unload Me


End Sub

le code de ma mise en forme "mefcAntipol

Sub mefcAntipol()
  Dim DerLig As Long, Sht As Worksheet
  ' Définir la feuille de destination de la MFC
  Set Sht = Sheets("Antipol")
  ' Mémoriser la dernière ligne remplie
  DerLig = Sht.Range("A" & Rows.Count).End(xlUp).Row
  ' Avec les cellules de la colonne A à Q
  With Sht.Range(Sht.Cells(DerLig, 1), Sht.Cells(DerLig, 18))
    .FormatConditions.Delete
    .FormatConditions.Add Type:=xlExpression, Formula1:= _
                          "=ET(" & Cells(DerLig, 1).Address & "<>"""";MOD(LIGNE();2)=0)"
    With .FormatConditions(1).Borders
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
    End With
    .FormatConditions(1).Interior.ColorIndex = 44
    .FormatConditions.Add Type:=xlExpression, Formula1:="=" & Cells(DerLig, 1).Address & "<>"""""
    With .FormatConditions(2).Borders
      .LineStyle = xlContinuous
      .Weight = xlThin
      .ColorIndex = xlAutomatic
    End With
  End With
End Sub

Par avance merci pour vos conseils sur le code éventuellement à améliorer.

Cordialement.

 

[eriiic]

Re : Rangement des données anormalement long en vba

Bonjour,

Vu qu’apparemment tu fais par plages complètes tu n'auras sans doute pas de gain énorme avec application.screenupdating=false au début des procédures qui écrivent sur les feuilles..
Essaie en désactivant le maximum de calculs :

    ' niveau app
    With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    ' niveau Feuille
    With ActiveSheet ' remplacer par les feuilles concernées
        ' saut de page
        .DisplayPageBreaks = False
        ' feuille avec données sources contenues dans des fichiers csv ou txt externes.
        .EnableCalculation = False
        ' 2007: calcul formats conditionnels
        .EnableFormatConditionsCalculation = False
    End With

A rétablir à la fin bien sûr.
eric