Discussion :

[fxfxfx]

Bonjour à tous !

J'ai concu une macro qui colorie des cases en fonction des jours si ils sont travaillés ou non... Cette macro fonctionne mais j'ai l'impression qu'elle est laborieuse.... Pour l'instant c'est juste une version d'essai sur une seule feuille et avec peu de données, et dans le futur tout va grossir...
A l'heure actuelle, la macro prends environ 7-8 sec alors je n'imagine pas à l'avenir....

Avez vous des idées pour optimiser ce 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
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub color_calendar()
Sheets("calendrier").Range("B2:AQ30").Interior.ColorIndex = 0
 
dernlignetravail = Sheets("données").Range("A65536").End(xlUp).Row
dernligneconges = Sheets("données").Range("C65536").End(xlUp).Row
 
For i = 2 To 30
For j = 2 To 43
For kk = 3 To dernligneconges '= 5 ou 6 environ
For k = 3 To dernlignetravail ' = 5 ou 6 environ
 
If Sheets("calendrier").Cells(i, j) <= Sheets("données").Cells(k, 2) _
    And Cells(i, j) >= Sheets("données").Cells(k, 1) Then
       Sheets("calendrier").Cells(i, j).Interior.ColorIndex = 43
 
Else
 
If Sheets("calendrier").Cells(i, j) <= Sheets("données").Cells(kk, 4) _
    And Cells(i, j) >= Sheets("données").Cells(kk, 3) Then
       Sheets("calendrier").Cells(i, j).Interior.ColorIndex = 45
End If
End If
 
Next
Next
Next
Next
 
End Sub

Merci beaucoup de votre aide !!

[Invité]

donnes un fichier.

fonction des jours si ils sont travaillés ou non.

Tu entends quoi par là, samedi, dimanche et jours fériés ?

[fxfxfx]

donnes un fichier.
Tu entends quoi par là, samedi, dimanche et jours fériés ?

Nan j'ai pas la contrainte des jours ouvrés...

par exemple je renseigne 05/02/2013 et 09/05/2013 et je veux que ca colorie toutes les cases entre les deux dates !

Ci-joint le fichier pour mieux voir de quoi il s'agit !

[Marc-L]

Bonjour.

Commencer par désactiver l'affichage via la propriété ScreenUpdating …

Pour encore réduire le temps, revoir la conception en utilisant des variables tableaux
(voir le tutoriel Utiliser les variables tableaux en VBA Excel) …


_______________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[el_slapper]

+1 avec mon prédecesseur, mais j'ai en plus un doute sur la double boucle intérieure.

En effet, tu continues à tester toutes les combinaisons de k et de kk même si tu as trouvé quelques chose. Est-ce que c'est voulu? Il me semble(mais corrige moi si je me trompe) que tu cherches à faire une coloration dès qu'il y a une valeur qui correspond.

Donc, je dirais une boucle sur le prioritaire, avec mise en couleur si trouvéé, et sinon, une boucle sur le moins prioritaire. Ca nécéssite de déclarer un booleen du genre

Code :

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

Dim Trouve as boolean

et de coder un truc du genre(en assumant que k est prioritaire sur kk) :

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
 
Trouve = false
For k = 3 To dernlignetravail ' = 5 ou 6 environ
 
If Sheets("calendrier").Cells(i, j) <= Sheets("données").Cells(k, 2) _
    And Cells(i, j) >= Sheets("données").Cells(k, 1) Then
       Sheets("calendrier").Cells(i, j).Interior.ColorIndex = 43
       Trouve = true
       Exit For
End If
next k
 
If Trouve
For kk = 3 To dernligneconges '= 5 ou 6 environ
If Sheets("calendrier").Cells(i, j) <= Sheets("données").Cells(kk, 4) _
    And Cells(i, j) >= Sheets("données").Cells(kk, 3) Then
       Sheets("calendrier").Cells(i, j).Interior.ColorIndex = 45
       Enf If
End If
Next kk
End If

Et ensuite, en phase 2, on remplace les cells(kk,4) et cells(k,3) par des tableaux. Plus un screenupdating = false au début( et = true à la fin), et ça devrait tourner beaucoup, beaucoup mieux.

Mais en fait, rien que le screenupdating devrait, dans ton cas, faire des miracles. Le reste, c'est du bonus.

[fxfxfx]

Merci beaucoup de vos réponses rapides!!

J'ai opté pour

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
Sub color_calendar()
 
Sheets("calendrier").Range("B2:AQ30").Interior.ColorIndex = 0
 
dernlignetravail = Sheets("données").Range("A65536").End(xlUp).Row
dernligneconges = Sheets("données").Range("C65536").End(xlUp).Row
 
For i = 2 To 30
For j = 2 To 43
 
For k = 3 To dernlignetravail ' = 5 ou 6 environ
 
If Sheets("calendrier").Cells(i, j) <= Sheets("données").Cells(k, 2) _
    And Cells(i, j) >= Sheets("données").Cells(k, 1) Then
       Sheets("calendrier").Cells(i, j).Interior.ColorIndex = 43
End If
Next k
 
For kk = 3 To dernligneconges '= 5 ou 6 environ
If Sheets("calendrier").Cells(i, j) <= Sheets("données").Cells(kk, 4) _
    And Cells(i, j) >= Sheets("données").Cells(kk, 3) Then
       Sheets("calendrier").Cells(i, j).Interior.ColorIndex = 45
 
End If
 
Next kk
 
Next
Next
 
End Sub