Accélérer ma macro, portant sur la fct TRIM

Bonjour

je récupère un fichier dont les dates sont sous forme de texte sur 3 colonnes et avec pleins d'espaces dans la colonne des mois (col B= jour, Col C = Année, col D= mois)

Pour récupérer les dates j'ai écris une macro qui met 11 secondes 35 pour 14337 lignes.

déjà, j'ai voulu traiter les espaces avec la fonction Trim et une routine, mais ça met encore plus de temps que d'écrire la fonction dans la plage, la copier et en coller les valeurs !

Voici mon code

Sub SupEspaceMois()
Dim DerLg As Long, Plage As Range, c As Range
Dim T As Long
T = Timer
DerLg = Range("D" & Rows.Count).End(xlUp).Row
Range("K2:K" & DerLg).Select
    With Selection
        .FormulaR1C1 = "=TRIM(RC[-7])"
        .Copy
        .PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        .Replace What:="JANVIER", Replacement:="01"
        .Replace What:="FÉVRIER", Replacement:="02"
        .Replace What:="MARS", Replacement:="03"
        .Replace What:="AVRIL", Replacement:="04"
        .Replace What:="MAI", Replacement:="05"
        .Replace What:="JUIN", Replacement:="06"
        .Replace What:="JUILLET", Replacement:="07"
        .Replace What:="AOÛT", Replacement:="08"
        .Replace What:="SEPTEMBRE", Replacement:="09"
        .Replace What:="OCTOBRE", Replacement:="10"
        .Replace What:="NOVEMBRE", Replacement:="11"
        .Replace What:="DÉCEMBRE", Replacement:="12"
    End With
Range("J2:J" & DerLg).Select
    With Selection
        .FormulaR1C1 = "=DATE(RC[-7],RC[1],RC[-8])"
        .Copy
    End With
Range("D2").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    Selection.NumberFormat = "dd/mm/yy;@"
MsgBox Timer - T    '11s35
'Set Plage = Range("D2:D" & DerLg)
'For Each c In Plage
'c.Value = Application.Trim(c.Value)
'Next
End Sub

Je vous joins également le fichier pour les tests https://www.cjoint.com/c/CDcwIO2T2OX

D'avance merci pour votre aide, pour améliorer mon code et en réduire le temps (J'ai plein d'autre infos à traiter avec Trim).

Bonsoir

A vérifier

Option Explicit

Sub SupEspaceMois()
Dim DerLg As Long, Plage As Range, c As Range
Dim T As Long
  T = Timer
  Application.ScreenUpdating = False
  DerLg = Range("D" & Rows.Count).End(xlUp).Row
  With Range("K2:K" & DerLg)
    .Formula = "=DATE(C2,MONTH(""1""&D2),B2)"
    .Value = .Value
    .Cut Range("D2")
  End With
  Application.ScreenUpdating = True
  MsgBox Timer - T
End Sub

Bonjour Banzai,

Toujours aussi performant, timer = 0,21

Merci et à bientôt.

Rechercher des sujets similaires à "accelerer macro portant fct trim"