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

Bastien43

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

VB:
Sub SupEspace()

Dim plage, cellule

Set plage = Range("D2:D12000")

For Each cellule In plage

    cellule.Value = Trim(cellule.Value)

Next cellule

End Sub
 
Solution
Bonjour Bastien43

Par tableau (array)
VB:
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é

XLDnaute Barbatruc
Bonjour Bastien43

Par tableau (array)
VB:
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é

XLDnaute Barbatruc
Re
Si il n'y a vraiment qu'une colonne :
VB:
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
 

patricktoulon

XLDnaute Barbatruc
Bonjour
essayez voir si ça c'est pas plus rapide
VB:
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

XLDnaute Barbatruc
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 :
VB:
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

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

XLDnaute Barbatruc
re
bonsoir @job75
pour moi ta macro ne fonctionne pas c'est pas bon
elle modifie le tableau
demo7.gif
 

patricktoulon

XLDnaute Barbatruc
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
 
Dernière édition:

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Test SupEspace(1).xlsm
    15.8 KB · Affichages: 21

Discussions similaires

  • Résolu(e)
Microsoft 365 supprimer espace
Réponses
41
Affichages
4 K
Réponses
12
Affichages
636

Statistiques des forums

Discussions
311 730
Messages
2 081 981
Membres
101 855
dernier inscrit
alexis345