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

 

[job75]

Merci beaucoup Efgé, donc sur 2007 ça ne va pas.

Il faudrait savoir ce qui se passe sur 2003, 2010, 2013, 2016.

Edit : patricktoulon a testé sur 2013, ça ne va pas.

 

[job75]

Efgé (2007) et patricktoulon est-ce que ça fonctionne en remplaçant D2: D12000 par D2: D100 ?

 

[patricktoulon]

re
sur 2013 32 bit ça fait pareil que 2007

on l'avait déjà vu ça avec @Yeahou
sur 2016 et 365 les formules sont automatiquement converties en matricielle
la mienne créé la matricielle et est compatible toute version
et en plus sur 365 y a même plus les accolades pour nous signaler que c'est des matricielles
sur 2016 je sais pas
ça c'est une information qu'il faudrait faire remonter a MS car c'est gênant
si on veut pas faire des matricielles
sinon il va y avoir de sérieux problèmes de compatibilité entre les versions

 

[Efgé]

Re

Efgé (2007) est-ce que ça fonctionne en remplaçant D2: D12000 par D2: D100 ?

Non

 

[patricktoulon]

re
avec D2100 c'est pareil

 

[Bernard_XLD]

Bonjour à tous

Testé sous 365, résultat correct avec la macro de Job75
J'ai ajouté une intersection implicite pour désactiver la matricielle dynamique de 365 et là, je reproduis le même problème que Patrick sous 2013 et Efgé sous 2007.

Cordialement, @+

 

[Bernard_XLD]

@patricktoulon et @Efgé ,

par curiosité, vous pouvez essayer avec cette syntaxe ?

Bien cordialement, @+

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

 

[patricktoulon]

re
non @Yeahou ça ne marchera pas
pour les version antérieures a 2016 il faut reconstruire la matricielle
Bon j'ai testé quand même par curiosité
ça c'est un gros problème je vous dis qu'il va falloir résoudre car c'est pas la première fois que l'on voit une bizarrerie pareille

 

[Efgé]

@patricktoulon et @Efgé ,

par curiosité, vous pouvez essayer avec cette syntaxe ?

Bien cordialement, @+

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

Même résultat sous 2007: Répétition de la première ligne sur l'ensemble de la plage

Cordialement

 

[job75]

sinon il va y avoir de sérieux problèmes de compatibilité entre les versions

Bah ce ne sera pas la 1ère fois que la compatibilité descendante n'est pas respectée.

Puisque ma macro du post #8 ne va pas utilisez celle-ci qui fonctionne sur toute version :

Sub SupEspace()
Application.ScreenUpdating = False
With [D2:D12000]
    .EntireColumn.Insert 'insère une colonne auxiliaire
    .Columns(0) = "=TRIM(RC[1])" 'SUPPRESPACE
    .Columns(0) = .Columns(0).Value 'supprime les formules
    .Value = .Columns(0).Value
    .Columns(0).EntireColumn.Delete
End With
End Sub

 

[patricktoulon]

a oui c'est une idée mais il y a
(deux calculate * le nombre de cells * le nombre de cells liées a celles ci par formule )de déclenchés
sur un range important ça va se sentir
avec la mienne il n'y en a qu'un(* le nombre de cellules liées à celles ci ) (normal puisque l'on change simplement la valeur dans les cellules elles mêmes

Function TriMAllCellsInRange(ByRef RnG As Range)'trim le left et right
'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(régularSpace)
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 supprime les espaces consécutif des valeurs
    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

c'est le rept qui recrée la matrice ,evaluate me renvoie alors une matrice et non un string comme dans ton post 8

 

[job75]

J'ai testé sur 1 000 000 de lignes avec la plage C2:C1000000 remplie par =" "&LIGNE()&" ":

- macro du post #3 => 0,95 seconde

- macro du post #25 => 3,3 secondes

- macro test du post #26 => 10,4 secondes

- macro test2 du post #26 => 2,4 secondes.

 

[patricktoulon]

re
ma fois la disparité de fonctionnement entre version d'excel commence a devenir déconcertante

 

[patricktoulon]

re
et c'est même pire chez moi le post 3 ne fonctionne pas
je raconte pas d’histoire vous l'avez sous les yeux

 

[Efgé]

re
et c'est même pire chez moi le post 3 ne fonctionne pas
je raconte pas d’histoire vous l'avez sous les yeux
Regarde la pièce jointe 1112280

La question portait sur les espaces Avant et Après le texte. Il n'a été question de supprimer les doubles espaces à l'intérieur des textes que dans tes interventions.

Cordialement