Simplification d'un bout de code répétitif

**neiluj26** · 02/06/2009, 15h41

Bonjour le forum,

J'ai créé un planning dans lequel un responsable remplit quotidiennement les affectations d'employés, en mettant un chiffre entre 1 et 7 dans la colonne du jour devant le nom de l'employé selon son affectation.
Il déclenche ensuite une macro qui calcule le nombre de personnes pour chaque affectation.

J'utilise ce code pour incrémenter les variables de "quantité de personnes":

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
 
Select Case Cells(j, i)
    Case "1":  Qte1 = Qte1 + 1
    Case "2":  Qte2 = Qte2 + 1
    Case "3":  Qte3 = Qte3 + 1
    Case "4":  Qte4 = Qte4 + 1
    Case "5":  Qte5 = Qte5 + 1
    Case "6":  Qte6 = Qte6 + 1
    Case "7":  Qte7 = Qte7 + 1
    Case "1/2", "2/1"
        Qte1 = Qte1 + 0.5
        Qte2 = Qte2 + 0.5
    Case "1/3", "3/1"
        Qte1 = Qte1 + 0.5
        Qte3 = Qte3 + 0.5
    Case "1/4", "4/1"
        Qte1 = Qte1 + 0.5
        Qte4 = Qte4 + 0.5
    Case "1/5", "5/1"
        Qte1 = Qte1 + 0.5
        Qte5 = Qte5 + 0.5
    Case "1/6", "6/1"
        Qte1 = Qte1 + 0.5
        Qte6 = Qte6 + 0.5
    Case "1/7", "7/1"
        Qte1 = Qte1 + 0.5
        Qte7 = Qte7 + 0.5
 
    Case "2/3", "3/2"
        Qte2 = Qte2 + 0.5
        Qte3 = Qte3 + 0.5
    Case "2/4", "4/2"
        Qte2 = Qte2 + 0.5
        Qte4 = Qte4 + 0.5
    Case "2/5", "5/2"
        Qte2 = Qte2 + 0.5
        Qte5 = Qte5 + 0.5
    Case "2/6", "6/2"
        Qte2 = Qte2 + 0.5
        Qte6 = Qte6 + 0.5
    Case "2/7", "7/2"
        Qte2 = Qte2 + 0.5
        Qte7 = Qte7 + 0.5
 
    Case "3/4", "4/3"
        Qte3 = Qte3 + 0.5
        Qte4 = Qte4 + 0.5
    Case "3/5", "5/3"
        Qte3 = Qte3 + 0.5
        Qte5 = Qte5 + 0.5
    Case "3/6", "6/3"
        Qte3 = Qte3 + 0.5
        Qte6 = Qte6 + 0.5
    Case "3/7", "7/3"
        Qte3 = Qte3 + 1
        Qte7 = Qte7 + 1
 
    Case "4/5", "5/4"
        Qte4 = Qte4 + 0.5
        Qte5 = Qte5 + 0.5
    Case "4/6", "6/4"
        Qte4 = Qte4 + 0.5
        Qte6 = Qte6 + 0.5
    Case "4/7", "7/4"
        Qte4 = Qte4 + 0.5
        Qte7 = Qte7 + 0.5
 
    Case "5/6", "6/5"
        Qte5 = Qte6 + 0.5
        Qte6 = Qte5 + 0.5
    Case "5/7", "7/5"
        Qte5 = Qte5 + 0.5
        Qte7 = Qte7 + 0.5
 
    Case "6/7", "7/6"
        Qte6 = Qt6 + 0.5
        Qte7 = Qte7  + 0.5
End Select

Mais comme vous le voyez, c'est un peu indigeste et long. Idéalement, je voudrais pouvoir simplifier ce code et pourquoi pas donner la possibilité au responsable d'ajouter de nouvelles affectations sans devoir ajouter du code à ce code.

**Krovax** · 02/06/2009, 16h16

J'ai une idée amusante mais qui devra sans doute être travaillé. Tout d'abor on va utiliser un tableau (cest quand même mieu que plein de variable

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Dim qte() As Double
Dim ntache As Integer 'nombre de tache
Dim w As Byte
 
ntache = 7  ' tu peux le modifier facilement
ReDim qte(1 To ntache)
 
w = CInt(Left(Cells(j, i), 1))
qte(w) = qte(w) + 0.5
w = CInt(Right(Cells(j, i), 1))
qte(w) = qte(w) + 0.5

Bon la je suis limité a 9 taches bon si tu veux faire plus que 9 tu devra sans doute tester la présence du / et agir en conséquence

**neiluj26** · 02/06/2009, 17h15

Aïe, je n'aurais pas dû modifier mon code avant de le présenter. Désolé. En fait, le responsable ne rentre pas de chiffres de 1 à 7, mais des lettres (P pour production par exemple etc). Mon "vrai" code donne donc ceci:

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
 
Select Case Cells(j, i)
    Case "P":  Qte1 = Qte1 + 1
    Case "K":  Qte2 = Qte2 + 1
    Case "I":  Qte3 = Qte3 + 1
    Case "D":  Qte4 = Qte4 + 1
    Case "A":  Qte5 = Qte5 + 1
    Case "C":  Qte6 = Qte6 + 1
    Case "R":  Qte7 = Qte7 + 1
    Case "P/K", "K/P"
        Qte1 = Qte1 + 0.5
        Qte2 = Qte2 + 0.5
    Case "P/I", "I/P"
        Qte1 = Qte1 + 0.5
        Qte3 = Qte3 + 0.5
    Case "P/D", "D/P"
        Qte1 = Qte1 + 0.5
        Qte4 = Qte4 + 0.5
    Case "P/A", "A/P"
        Qte1 = Qte1 + 0.5
        Qte5 = Qte5 + 0.5
    Case "P/C", "C/P"
        Qte1 = Qte1 + 0.5
        Qte6 = Qte6 + 0.5
    Case "P/R", "R/P"
        Qte1 = Qte1 + 0.5
        Qte7 = Qte7 + 0.5
 
    Case "K/I", "I/K"
        Qte2 = Qte2 + 0.5
        Qte3 = Qte3 + 0.5
    Case "K/D", "D/K"
        Qte2 = Qte2 + 0.5
        Qte4 = Qte4 + 0.5
    Case "K/A", "A/K"
        Qte2 = Qte2 + 0.5
        Qte5 = Qte5 + 0.5
    Case "K/C", "C/K"
        Qte2 = Qte2 + 0.5
        Qte6 = Qte6 + 0.5
    Case "K/R", "R/K"
        Qte2 = Qte2 + 0.5
        Qte7 = Qte7 + 0.5
 
    Case "I/D", "D/I"
        Qte3 = Qte3 + 0.5
        Qte4 = Qte4 + 0.5
    Case "I/A", "A/I"
        Qte3 = Qte3 + 0.5
        Qte5 = Qte5 + 0.5
    Case "I/C", "C/I"
        Qte3 = Qte3 + 0.5
        Qte6 = Qte6 + 0.5
    Case "I/R", "R/I"
        Qte3 = Qte3 + 1
        Qte7 = Qte7 + 1
 
    Case "D/A", "A/D"
        Qte4 = Qte4 + 0.5
        Qte5 = Qte5 + 0.5
    Case "D/C", "C/D"
        Qte4 = Qte4 + 0.5
        Qte6 = Qte6 + 0.5
    Case "D/R", "R/D"
        Qte4 = Qte4 + 0.5
        Qte7 = Qte7 + 0.5
 
    Case "A/C", "C/A"
        Qte5 = Qte6 + 0.5
        Qte6 = Qte5 + 0.5
    Case "A/R", "R/A"
        Qte5 = Qte5 + 0.5
        Qte7 = Qte7 + 0.5
 
    Case "C/R", "R/C"
        Qte6 = Qt6 + 0.5
        Qte7 = Qte6 + 0.5
End Select

Ton idée est intéressante, mais je ne peux pas demander à ce reponsable de se souvenir de chiffres.

**Gorfael** · 02/06/2009, 17h31

Salut neiluj26 et le forum

je ne peux pas demander à ce reponsable de se souvenir de chiffres.

t'es salaud avec lui

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
Dim tab_v(1 To 2) As String
Dim x As Integer
'...............
If Len(Cells(j, i)) = 1 Then
    tab_v(1) = Cells(j, i)
    tab_v(2) = Cells(j, i)
Else
    tab_v(1) = Left(Cells(j, i), 1)
    tab_v(2) = Right(Cells(j, i), 1)
End If
For x = 1 To 2
    Select Case tab_v(x)
        Case "P": Qte1 = Qte1 + 0.5
        Case "K": Qte2 = Qte2 + 0.5
        Case "I": Qte3 = Qte3 + 0.5
        Case "D": Qte4 = Qte4 + 0.5
        Case "A": Qte5 = Qte5 + 0.5
        Case "C": Qte6 = Qte6 + 0.5
        Case "R": Qte7 = Qte7 + 0.5
    End Select
Next x

une solution
A+

**neiluj26** · 02/06/2009, 17h48

Merci pour la solution Gorfaël, je vais tester, et mettrai le topic en résolu ensuite.
Merci Krovax aussi. Je retiens ta solution pour une prochaine fois.

Et oui, je suis un peu salaud, mais je sais que ça va provoquer des erreurs que je devrai réparer.

Simplification d'un bout de code répétitif

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager