Ma fonction tourne à l'infini

[pepsister]

Bonjour,

J'ai un bout de code me permettant de supprimer les espaces superflus dans mes cellules, le problème c'est que mon code ne s'arrête jamais, comment faire?

Mon tableau possède une centaine de colonnes pour 90 000 lignes. La macro tourne plus de 30min avant que je l'arrête.

Voici mon bout de code:

Dim Cell As Range
Application.EnableEvents = False
For Each Cell In ActiveSheet.UsedRange
    Cell.Value = Application.WorksheetFunction.Trim(Cell.Value)
Next
Application.EnableEvents = True
End Sub

Comment faire pour que la macro se termine un jour et soit moins longue?

Merci de votre aide

 

[Misange]

Re : Ma fonction tourne à l'infini

Bonjour

pas de pb avec ton code. Vérifie quel est vraiment le used range sur ta feuille
Ajoute également un

Application.ScreenUpdating = False
ModeRecalcul = Application.Calculation
' Réglage du recalcul sur mode manuel
Application.Calculation = xlCalculationManual

en début de macro et remet tout ça à vrai et en auto à la fin

 

[laurent950]

Re : Ma fonction tourne à l'infini

Bonjour,

Fini les boucles infini !!!

en deux ligne avec explication c'est très efficace.

"Mon tableau possède une centaine de colonnes pour 90 000 lignes. La macro tourne plus de 30min avant que je l'arrête" = avec mon code se sera Instantané.

Code :

Sub test()

' Tableaux
' Range(Cells(2, 2) :
' Premiere celule du tableau pour 2,2 c'est la celule B2
' Cells(Cells(65536, 2).End(xlUp).Row, Cells(2, 256).End(xlToLeft).Column)
' ici Cells(65536, 2).End(xlUp).Row = Pour la derniére ligne "Non Vide" de la colonne B2
' Ici Cells(2, 256).End(xlToLeft).Column = Pour la derniére colonne "Non Vide" de la colonne IV2
'
Set T = Range(Cells(2, 2), Cells(Cells(65536, 2).End(xlUp).Row, Cells(2, 256).End(xlToLeft).Column))
' Nettoyage format du tableau
Range(T.Address) = Application.Trim(T.Value) ' 'Supprime tous les espaces en trop

End Sub

PS : Pour cela un lien explicatif sur cette fonction "ActiveSheet.UsedRange.select" qui sélectionne toute la feuille

Utilisation des fonctions Excel dans VBA

Laurent

 

[pepsister]

Re : Ma fonction tourne à l'infini

Désolé mais avec ce code je me prends une erreur 13: incompatibilité de type.
J'ai en effet modifié un peu le code parce que j'ai bcp plus de lignes que ce que tu mets dans ton bout de code

' Tableau
Set T = Range(Cells(1, 1), Cells(Cells(1048576, 1).End(xlUp).Row, Cells(1, 16384).End(xlToLeft).Column))
' Nettoyage format du tableau
Range(T.Address) = Application.Trim(T.Value) ' 'Supprime tous les espaces en trop

 

[laurent950]

Re : Ma fonction tourne à l'infini

Bonsoir,

Sub test()

' Tableau
' Nettoyage format du tableau
For i = 1 To 1048576
For j = 1 To 16384
Cells(i, j) = Application.Trim(Cells(i, j)) ' 'Supprime tous les espaces en trop
Next j
Next i

End Sub

Laurent

 

[mapomme]

Re : Ma fonction tourne à l'infini

Bonjour pepsister, à tous,

Un essai en utilisant une fonction personnalisée et un tableau pour tenter d'accélérer l'exécution.
Cliquer sur "Init" pour inscrire sur la feuille 9 000 000 cellules avec texte.
Cliquer sur "Go" pour lancer la suppression des espaces redondants.
(env. 12s pour l'initialisation et un peu moins de 3mn pour la suppression sur mon bouzin).

Le code:

Sub TestTrim()
Dim maZone As Range, Col As Range, colVals
Dim h0 As Single, i As Long, ModeRecalcul

h0 = Timer
Application.ScreenUpdating = False
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual

Set maZone = ActiveSheet.UsedRange
For Each Col In maZone.Columns
  colVals = Col.Value
  For i = 1 To UBound(colVals)
    colVals(i, 1) = xlTrim(colVals(i, 1))
  Next i
  Col = colVals
Next Col

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
ActiveSheet.Columns("A:CW").EntireColumn.AutoFit
MsgBox Format(Timer - h0, "0,00""s""")
End Sub

Function xlTrim(xS) As String
Dim L
xlTrim = Trim(xS)
Do
  L = Len(xlTrim)
  xlTrim = Replace(xlTrim, "  ", " ")
Loop Until L = Len(xlTrim)
End Function

 

[herve62]

Re : Ma fonction tourne à l'infini

Bonjour
Laurent , merci pour le lien des tableaux , déjà classé dans le grenier ....
Luc : Slt & amitiés bonne journée aussi