Discussion :

[Tomuscz]

Salut tout le monde,

Je vais peut être paraitre culotté mais j'espère que non....
En fait je suis débutant (du moins je l'étais vraiment il y a 1semaine mais j'ai un peu progressé du coup) et j'ai réalisé une petite macro.
Par contre vu que je débute j'ai pas du l'optimiser complétement parce que je la trouve particulièrement lente à s'executer.
Je voulais donc savoir si en vous la mettant en ligne vous pouviez jeter un coup d'oeil et corriger certaines conneries qui me bouffent un temps fou...

Merci d'avance à tous ceux qui se pencheront sur mon fichier pour me donner un coup de main

PS : je joinds 3 fichiers texte pour pouvoir faire 3imports. Au début du lancement de mon fichier excel on vous invite à dire combien vous voulez ouvrir de fichiers ( vous pouvez donc en ouvrir jusqu'à trois).

Vous allez trouver la macro pas si lente avec ces fichiers la parce qu'ils ne sont pas long. Les "vrais" fichiers feront plus de 2000lignes donc c'est beaucoup BEAUCOUP plus long..

Dernière info, avant de sortir du fichier il faut supprimer toutes les feuille et ne laisser qu'une seule feuille Nommée Feuil1 complétement vide

Le fichier : http://www.megaupload.com/?d=X1HMBFPV

[ouskel'n'or]

Mets plutôt le code de la macro qui rame, tu auras d'avantage de suggestions

[Tomuscz]

Pardon ....

Je vais essayé de te faire une séléction de ce qui ralenti le plus (cela dit si les autres veulent bien regarder en global la macro ça serait top)

1) "Scann" de toutes les lignes pour retirer les doublons et ainsi ne garder qu'un exemplaire du titre de chaque sous chapitre

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
    ("Calcul").Select
    NouvNbreLignes = Application.CountA(Range("A1:A65536")) + 4
    Sheets("Calcul").Range(Cells(5, 3), Cells(NouvNbreLignes, 3)).Select
    Selection.Copy
    Sheets("Choix Chapitres").Select
    Range("A5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Cells(5, 2).Select
    ActiveCell.FormulaR1C1 = "=PROPER(RC[-1])"
    Selection.AutoFill Destination:=Range(Cells(5, 2), Cells(NouvNbreLignes, 2)), Type:=xlFillDefault
 
    Range(Cells(5, 2), Cells(NouvNbreLignes, 2)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
 
    Range("A5").Select
    donnee1 = ActiveCell
    ActiveCell.Offset(1, 0).Select
    While ActiveCell <> ""
    If ActiveCell = donnee1 Then
 
ActiveCell.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select
Else
 donnee1 = ActiveCell
 ActiveCell.Offset(1, 0).Select
 End If
 
Wend

2) Création de CheckBox dans une colonne pour toutes les lignes (parfois il y a plus de 2000lignes....)

Pour les x feuilles présentes dans l'analyse que souhaite faire l'utilisateur on se retrouve avec ca :

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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
Sub InsertionCheckFeuilx()
 
 
    Dim x As Integer
    Dim i As Integer
 
 
'Boucle de 1 à Compteur, pour répéter l'opération sur toutes les feuilles concernées.
    For x = 1 To Compteur
    Worksheets(x).Select
    NbreLignes = Application.CountA(Range("E1:E65536")) + 3
    Range("T4").Select
    ActiveCell.FormulaR1C1 = "Pris en compte"
    With ActiveCell.Characters(Start:=1, Length:=14).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("T4").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    Range(Cells(5, 20), Cells(NbreLignes, 20)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
          For i = 5 To NbreLignes
          Worksheets(x).Activate
          Cells(i, 20).Select
          t = ActiveCell.Top
          l = ActiveCell.Left
          Set obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
               DisplayAsIcon:=False, Left:=l + 30, Top:=t + 2, Width:=10, Height:=10 _
               )
        Next i
        NbreTaches = NbreLignes - 4
        For k = 1 To NbreTaches
        Worksheets(x).OLEObjects(k).Object.Value = True
        Next k
        Cells(5, 21).Select
        ActiveCell.FormulaR1C1 = "TRUE"
        Selection.AutoFill Destination:=Range("U5:U" & NbreLignes & ""), Type:=xlFillDefault
 
    ActiveSheet.Buttons.Add(1508.25, 20.25, 57.75, 15.75).Select
    Selection.OnAction = "Bouton2_QuandClic"
    Selection.Characters.Text = "Mise à jour"
    With Selection.Characters(Start:=1, Length:=11).Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Columns("U:U").Select
    Selection.Font.ColorIndex = 2
      Next x
 
End Sub
 
 
 
 
Voila je pense que la se trouvent les 2principaux points noirs. Après le reste doit pas être trop méchant

[Krovax]

Bien commence par enlever TOUS les select. Tu gagnera énormément de temps

A chaque fois tu dis
Selection tel objet
apllique ceci sur la selection

ca va beaucoup plus vite de ire applique ceci sur la selection

Exemple

Code :

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

1
2
3
    Cells(5, 2).Select
    ActiveCell.FormulaR1C1 = "=PROPER(RC[-1])"
    Selection.AutoFill Destination:=Range(Cells(5, 2), Cells(NouvNbreLignes, 2)), Type:=xlFillDefault

devient

Code :

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

1
2
    Cells(5, 2).FormulaR1C1 = "=PROPER(RC[-1])"
    Cells(5, 2).AutoFill Destination:=Range(Cells(5, 2), Cells(NouvNbreLignes, 2)), Type:=xlFillDefault

en résumé

Code :

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

1
2
3
XXX.select
selection.YYYYY
activecell.ZZZZ

devient

Code :

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

1
2
XXXX.YYYY
XXXX.ZZZZ

Pour les feuilles

Code :

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

Worksheets(x).Select

remplace par
With Worksheets(x)
et commence tes Range("T4") ou cells ou quoi que ce soit contenue dans la feuille par

Code :

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

 .Range("T4")

Le with permet d'éviter de réécrir tjs la même chose

Code :

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

1
2
3
4
5
 
With XXXX
.yyyy
.zzzz
end with 'a ne pas oublier

revien a ecrire

Code :

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

1
2
XXXX.yyyy
XXXX.zzzz

J'espère que c'est assez clair

[ouskel'n'or]

Je suppose que la mise en forme des caractères doit elle aussi prendre pas mal de temps alors neutralise la mise à jour de l'écran à chaque modification de cette mise en forme, en mettant au début et à la fin de ta macro :

Code :

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

1
2
3
4
5
6
7
8
Sub lamacro()
     'Début
     Application.screenupdating = false
     '...
 
     'Fin
     Application.screenupdating = True
End sub

[Tomuscz]

Merci beaucoup pour vos premières réponses....

J'avais commencé à enlever les Select.
Par contre j'ai un soucis à un moment :

J'avais dans la version d'origine :

Code :

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

1
2
3
4
ActiveSheet.Buttons.Add(35.25, 7.5, 147, 22.5).Select
    Selection.OnAction = "Bouton1_QuandClic"
    ActiveSheet.Shapes("Button 1").Select
    Selection.Characters.Text = "Mise à jour de la séléction"

que j'ai tenté de remplacer par :

Code :

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

1
2
Sheets("Choix Chapitres").Buttons.Add(35.25, 7.5, 147, 22.5).OnAction = "Bouton1_QuandClic"
    Sheets("Choix Chapitres").Shapes("Button 1").Characters.Text = "Mise à jour de la séléction"

mais la deuxième ligne bug, comment puis-je l'écrire ?