Discussion :

[Poussemousse]

Bonjour,

J'ai dans une macro une vérification que chaque cellule de ma plage se terminant par un espace, est remplacée par la même valeur mais sans l'espace.

J'ai donc utilisé une imbrication de 2 boucles, mais dès que des espaces sont trouvés ça devient long :
Extrait de code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
        R = 4
        C = 1
        Do
            Do
                If Right(Cells(R, C).Value, 1) = " " Then
                    Cells(R, C).Value = Left(Cells(R, C).Value, Len(Cells(R, C).Value) - 1)
                End If
                C = C + 1
            Loop While (C < 8)
            R = R + 1
            C = 1
            Application.StatusBar = "Soyez patient..." & Round((R - 4) / (NbLig - 4) * 100, 0) & "%"
        Loop While (R < NbLig)
        Application.StatusBar = ""

Est-ce que quelqu'un aurait une idée pour accélérer ce traitement : jusqu'à 2 minutes pour une plage de 400 lignes * 8 colonnes ! d'où le rajout dans la barre de statut du %age d'avancement.

Merci

[NVCfrm]

Salut,
Petite visite dans les contributions : http://www.developpez.net/forums/d11...-trim-tableau/

[danixdb]

Bonjour Poussemousse, NVCfrm, Le Forum

Déjà eu un problème de ce genre à traiter et sur un fichier de 10000 lignes et 8 colonnes, temps de traitement d'environ 15 secondes. Peut-être y a-t-il autre méthode plus rapide, à voir je vais suivre le fil.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Sub SuppimerEspace()
  Dim dtDeb As Date, dtFin As Date
  Dim i As Integer
 
  Application.ScreenUpdating = False
  dtDeb = Now
  Cells(1, 1).Select
  Do While Not IsEmpty(ActiveCell.Value)
    For i = 1 To 8
      Cells(ActiveCell.Row, i).Value = Trim(Cells(ActiveCell.Row, i).Value)
    Next
    ActiveCell.Offset(1, 0).Select
  Loop
  dtFin = Now
  Application.ScreenUpdating = True
  MsgBox dtDeb & Chr(13) & dtFin
End Sub

Slts

[geogeo70]

.... une idée pour accélérer ce traitement : jusqu'à 2 minutes pour une plage de 400 lignes * 8 colonnes ! d'où le rajout dans la barre de statut du %age d'avancement.....

Bonsoir,

J'ai essayé avec l'itération for each et cela semble très rapide, j'ai fait un essai avec 643 lignes avec toutes les cellules avec un espace.

voilà mon code, il faudrait rendre vaviable le nombre de lignes en utilisant "Range.end(xlup)" par exemple et recalculer le % en comptant les cellules.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub essai()
 
Dim Nblig As Integer
 
Dim plage As Range, Cel As Range
 
Set plage = Range("A4:H643")
 
For Each Cel In plage
    If Right(Cel.Value, 1) = " " Then
        Cel.Value = Left(Cel.Value, Len(Cel.Value) - 1)
    End If
Next Cel
Application.StatusBar = "Soyez patient..."
Application.StatusBar = ""
End Sub

le fichier :espaces2.xlsm

a++
geogeo70

[vinc_bilb]

Bonjour,

Autre alternative à adapter:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Subst_test()
 
Dim InpRng As Range, Cl As Range
 
Set InpRng = ThisWorkbook.Worksheets(1).Range("B1").CurrentRegion.Columns(1)
Debug.Print InpRng.Address
 
' Si il n'y a pas d'autres ' ', il vaut mieux faire un replace sur le range
InpRng.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
 
' Autrement, voir les autres propositions
For Each Cl In InpRng.Cells
    If Right(Cl.Value, 1) = " " Then Cl.Value = Left(Cl.Value, Len(Cl.Value) - 1)
Next Cl
 
End Sub

[kiki29]

Salut, comme indiqué plus haut : Trim$

[Poussemousse]

Bonsoir à tous qui avez apporté votre soutien à mon problème.

Après différents essais, voici mes résultats chronométrés :
Ma double boucle de base avec équation de remplacement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 R = 4
        C = 1
        Do
            Do
                If Right(Cells(R, C).Value, 1) = " " Then
                    Cells(R, C).Value = Left(Cells(R, C).Value, Len(Cells(R, C).Value) - 1)
                End If
                C = C + 1
            Loop While (C < 8)
            R = R + 1
            C = 1
           Application.StatusBar = "Soyez patient..." & Round((R - 4) / (NbLig - 4) * 100, 0) & "%"
       Loop While (R < NbLig)

= 1min 16s


Méthode de geogeo70

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
   Set Rplage = Range("A4:G" & NbLig)
 
For Each Cel In Rplage
    If Right(Cel.Value, 1) = " " Then
        Cel.Value = Left(Cel.Value, Len(Cel.Value) - 1)
    End If
Next Cel

= 1min 26


Méthode mixte danixdb/geogeo70 en remplaçant le Trim par RTrim =

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For Each Cel In Rplage
    Cel.Value = RTrim(Cel.Value)
Next Cel

=1min 29

Si quelqu'un a réussi à faire 1000 lignes avec 8 colonnes en 15s je dois changer de machine (je n'ai qu'un Intel Core(TM)2 Quad CPU @2.50Ghz)...

Pour aller très vite, je crois qu'il ne me reste plus qu'à prendre mon texte, le copier puis coller dans Word et faire un Remplacer "^t " par "^t" suivi d'un Remplacer "^p " par "^p".
ce qui se fait en 1 à 2 secondes, puis revenir dans Excel et recoller les valeurs.

Un nouveau conseil SVP ?

[Poussemousse]

Bon j'ai fini par écrire un peu de VBA Word et ça marche impeccablement : 2 secondes au lieu de 90 à 95s sous Excel...

Le code est moins compact, mais comme il n'y a plus de boucle c'est bien plus efficace.

Pour danixdb qui était intéressé par le fil, voilà le morceau de code à insérer dans Excel.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
 
   Dim WordDoc As Word.Document
   Dim WordApp As Word.Application
.....
.....
 'ouvre session word
    Set WordApp = New Word.Application
    'word est masqué pendant l'opération
    WordApp.Visible = False
 
    ' Création d'un nouveau document :
    Set WordDoc = WordApp.Documents.Add
 
    ' Collage sous forme de texte simple du texte comprenant les espaces à supprimer,
    ' qui dans Excel sont en fin de cellule, ce qui correspond sous Word à devant une tabulation "^t" ou une marque de paragraphe "^p"
    WordApp.Selection.PasteSpecial DataType:=wdPasteText, DisplayAsIcon:=False
 
    ' Suppression des espaces devant Tabulation
    WordApp.Selection.Find.ClearFormatting
    WordApp.Selection.Find.Replacement.ClearFormatting
    With WordApp.Selection.Find
        .Text = " ^t"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    WordApp.Selection.Find.Execute Replace:=wdReplaceAll
 
    ' Suppression des espaces devant marque de paragraphe
    With WordApp.Selection.Find
        .Text = " ^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    WordApp.Selection.Find.Execute Replace:=wdReplaceAll
 
    ' Tentative de masquage des Alertes (sans succès) !!!
    ' Je sélectionne tout et copie le texte sans les espaces dans le presse-papier
    With WordApp
        .DisplayAlerts = wdAlertsNone
        .Selection.WholeStory
        .Selection.Copy
    End With
 
    ' Collage de retour dans Excel
    Range("A4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
 
    ' Fermeture du document Word sans sauvegarde
    WordDoc.Close False
 
    'Comme le WordApp.Application.DisplayAlerts = False ne fonctionne pas, problème Office 2010 ?
    'je force le vidage du presse papier avant de quitter l'application, ce qui m'évite le message d'alerte
    Set objTexte = New DataObject
    objTexte.SetText ""
    objTexte.PutInClipboard
    Set objTexte = Nothing
 
    WordApp.Quit
    Set wdDoc = Nothing
    Set wdApp = Nothing

J'attends encore un peu avant de clore le fil, au cas où quelqu'un aurait la recette miracle dans Excel, qui pour une fois, se fait battre par Word...

[Michel_M]

Bonjour

adapter les adresses de celules
400 lignes, 8 colonnes en 0,046 secondes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Option Explicit
Option Base 1
'--------
Sub supprimer_espace_fin()
Dim Derlig As Integer, T_in
Dim col As Byte, Lig As Integer, T_out
Dim Start As Single
'Dim xxx 'test
'initialisations
    Start = Timer
    Application.ScreenUpdating = False
    Derlig = Columns("A").Find("*", , , , , xlPrevious).Row
    T_in = Range("A1:I" & Derlig)
    ReDim T_out(Derlig, 8)
'traitement
    For Lig = 1 To UBound(T_in)
        For col = 1 To 8
            T_out(Lig, col) = Trim(T_in(Lig, col))
            'xxx = Len(T_out(Lig, col)) test de suppresssion
        Next
    Next
'restitutrion
Range("A1").Resize(UBound(T_out), 8) = T_out
Application.ScreenUpdating = True
MsgBox "durée: " & Timer - Start & " .sec"
End Sub

[Marc-L]

Bonjour, bonjour !

Plusieurs possibilités comme par exemple Utiliser les variables tableaux …
Voir les exemples dans le bon forum, là où il y a le plus de passage, ici c'est celui des formules de calculs !

Peut aussi s'effectuer sans boucle via une fonction de feuille de calculs en moins de dix lignes de code,
exécution inférieure à 0,04s pour 1000 lignes de 8 colonnes (tout dépend aussi du processeur) …


__________________________________________________________________________________________________
Tous unis, tous Charlie

[Poussemousse]

Merci Marc,
je ne connaissais pas cette possibilité de passer par un tableau "copie" du Tableau Excel.
Bilan :


Je clos ce fil, encore un grand merci à la communauté pour le temps passé à aider ceux qui peinent.

Poussemousse

[Marc-L]

De rien mais l'autre solution demande moins de lignes de code (<10) et pourrait s'avérer plus rapide !

Si cela t'intéresse, ouvre une nouvelle discussion dans le bon forum, celui dédié au VBA Excel,
en y postant ta solution actuelle et après tu pourras comparer …