Bonjour,

Je suis débutant en VBA Excel.

J'ai créé une macro. qui :
- balaye un ensemble de lignes et met en rouge les cellules de la colonne J lorsque sa valeur est à "x",
- supprime la ligne lorsque la valeur de la cellule de la colonne L est à "x",
- trie par une partie de la colonne F puis je prends l'intégralité de mon tableau,
-met des bordures sur l'ensemble de mon tableau.

Je dois mal m'y prendre car le temps d'exécution est bien trop long.
J'ai essayé de geler l'écran et le calcul automatique avant puis les réactiver après mais cela ne donne pas grand chose.


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
Dim lastlig As Long
 
   Dim ligne_traitee As Long
 
   ' Détermination de la dernière ligne de la feuille 1 (Prépa. palette)
   Worksheets("Prepa palette").Activate
   With Worksheets("Prepa palette")
        lastlig = .Cells(.Rows.Count, "E").End(xlUp).Row
   End With
 
   ligne_traitee = 4
 
   Do Until ligne_traitee = lastlig
 
      Range("J" & ligne_traitee).Select
      If Selection.Value = "x" Then
         With Selection.Interior
          .ColorIndex = 3
          .Pattern = xlSolid
         End With
      End If
 
      If Range("K" & ligne_traitee) = "x" Then
         Rows(ligne_traitee).EntireRow.Delete Shift:=xlUp
      Else
         ligne_traitee = ligne_traitee + 1
      End If
   Loop
 
   ' Récupération de la dernière ligne après suppression
   Worksheets("Prepa palette").Activate
   With Worksheets("Prepa palette")
        lastlig = .Cells(.Rows.Count, "E").End(xlUp).Row
   End With
 
   ' Tri par date de livraison croissante
   Range("F3:F" & lastlig).Select
   Selection.Sort Key1:=Range("F3"), Order1:=xlAscending, Header:=xlGuess, _
   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
   ' Mise en gras de la colonne de date de livraison.
   Range("F3:F" & lastlig).Select
   Selection.Font.Bold = True
 
   ' Remise des bordures sur l'ensemble des cellules
   Range("A4:L" & lastlig).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(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
   End With
   With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
   End With
 
 
   MsgBox "Suppression terminée!"
Merci d'avance de votre aide.
Julien.