Rangement des données anormalement long en vba

fr832

XLDnaute Occasionnel
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
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

Code:
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

XLDnaute Barbatruc
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 :
Code:
    ' 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
 

Discussions similaires

Réponses
18
Affichages
2 K
Réponses
8
Affichages
617

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 837
dernier inscrit
Ugo