XL 2019 Suppression espace de début et fin - Macro très rapide

[Bastien43]

Bonjour,

J'ai créé cette macro pour supprimer les espaces de début et de fin de chaque cellule (de toute une colonne : 12000 lignes)

Comment accélérer la macro, ce n'est pas rapide... ?? Existe-t-il un code plus rapide ?

Sub SupEspace()

Dim plage, cellule

Set plage = Range("D2:D12000")

For Each cellule In plage

    cellule.Value = Trim(cellule.Value)

Next cellule

End Sub

 

[Efgé]

Bonjour Bastien43

Par tableau (array)

Sub SupEspace2()

Dim plage As Range
Dim T As Variant
Dim i&, j&

Set plage = Range("D2:D12000")
T = plage
For i = LBound(T, 1) To UBound(T, 1)
    For j = LBound(T, 2) To UBound(T, 2)
        T(i, j) = Trim(T(i, j))
    Next j
Next i
plage.FormulaLocal = T
End Sub

Cordialement

 

[Efgé]

Re
Si il n'y a vraiment qu'une colonne :

Sub SupEspace3()

Dim plage As Range
Dim T As Variant
Dim i&

Set plage = Range("D2:D12000")
T = plage
For i = LBound(T, 1) To UBound(T, 1)
    T(i, 1) = Trim(T(i, 1))
Next i
plage.FormulaLocal = T
End Sub

Cordialement

 

[Bastien43]

Bonjour,

Super cela fonctionne, merci pour la réponse rapide et l'aide

Cordialement

 

[job75]

Bonjour Bastien43, Efgé,

@Efgé pourquoi .FormulaLocal puisque T contient des valeurs ?

A+

 

[Efgé]

Bonjour Job
Je me méfie toujours.
On ne sait jamais, sans les espaces le texte peut devenir date

Cordialement

 

[patricktoulon]

Bonjour
essayez voir si ça c'est pas plus rapide

Function TriMAllCellsInRange(ByRef RnG As Range)
'supprime les espace en debut et fin de chaine de  caracteres dans une plage  equivalent de "Ltrim" in one shoot
    With RnG.Parent.Range(RnG.Address)
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",FIND(MID(TRIM(" & .Address & "),1,2)," & .Address & ",1),LEN(" & .Address & ")),REPT(" & .Address & ",1))")
        TriMAllCellsInRange = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",1,FIND(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100))," & .Address & ",1)+LEN(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100)))-1),REPT(" & .Address & ",1))")
    End With
End Function
'
'
'equivalent à application.trim de VBA
Function SupprfirstAndNexAndDoubleSpaceInRange(ByRef RnG As Range)
'supprime tout les espaces avant et apres la chaine et tout les doubles espaces dans la chaine in one shoot
    With RnG
        SupprfirstAndNexAndDoubleSpaceInRange = Evaluate("IF(ISTEXT(" & .Address & "),TRIM(" & .Address & "),REPT(" & .Address & ",1))")
    End With
End Function '

Sub test() 'trim les valeurs dans la plage
    Dim DL, RnG As Range
    DL = Cells(Rows.Count, 3).End(xlUp).Row
    Set RnG = Sheets(1).Range("C2:C" & DL)
    RnG.Value = TriMAllCellsInRange(RnG)
End Sub

Sub test2() 'trim et rsupprime les espaces consecutif des valeur
    Dim DL, RnG As Range
    DL = Cells(Rows.Count, 3).End(xlUp).Row
    Set RnG = Sheets(1).Range("C2:C" & DL)
    RnG.Value = SupprfirstAndNexAndDoubleSpaceInRange(RnG)
End Sub

 

[job75]

Bonjour à tous,

Je n'ai jamais vu supprimer les espaces de début et de fin sans supprimer les espaces intermédiaires superflus.

J'ai donc toujours vu utiliser la fonction SUPPRESPACE ce qui en VBA donne :

Sub SupEspace()
With [D2:D12000]
    .Name = "P" 'plage nommée
    .Value = [TRIM(P)] 'SUPPRESPACE
End With
End Sub

C'est un calcul matriciel mais il est très rapide.

A+

 

[Modeste geedee]

Bonjour à tous,

Je n'ai jamais vu supprimer les espaces de début et de fin sans supprimer les espaces intermédiaires superflus.

Noter que la fonction Vba TRIM
Suppression des espaces avant et après sans toucher aux espaces intérieurs

se comporte différemment de la fonction WorksheetFunction.Trim
Suppression des espaces avant et après
ET réduction des espaces intermédiaires à un seul

 

[patricktoulon]

re
bonsoir @job75
pour moi ta macro ne fonctionne pas c'est pas bon
elle modifie le tableau

 

[job75]

Noter que la fonction Vba TRIM
Suppression des espaces avant et après sans toucher aux espaces intérieurs

se comporte différemment de la fonction WorksheetFunction.Trim
Suppression des espaces avant et après#8
ET réduction des espaces intermédiaires à un seul

Bien sûr et au post #8 c'est la fonction Excel qui est évaluée entre crochets.

 

[patricktoulon]

re
Bonjour @job75
ça ne fonctionne pas chez moi tu me peux dire pourquoi ?
voir capture animée dans mon post précédent
je sens bien qu'il y a une notion de matricielle (comme dans ma version evaluate d'ailleurs) mais je pige pas ta version en fait en tout cas chez moi ça fait pas le job et ça modifie les valeurs
EXCEL 2013

édit: oui je viens d'essayer sur 3 lignes et c'est bien ça, ça répète la 1 ère valeur en fait

 

[job75]

Bonjour le forum,

édit: oui je viens d'essayer sur 3 lignes et c'est bien ça, ça répète la 1 ère valeur en fait

Pas du tout, chez moi sur Excel 2019 ma macro va très bien, testez le fichier joint.

Il y aurait des problèmes sur d'autres versions ? Merci les amis de dire ce qui se passe chez vous.

A+

 

[Efgé]

bonjour à tous

Sous 2007 : résultat de $D$2 à $D$12000

Cordialement

 

[Efgé]

Re
Sous 365 Résultat en $D$2:$D$4 :

Cordialement