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.