Bonjour à tous,

Encore un sujet qui me paraît complexe.. Je vais essayer d'être clair !

Je suis face à un tableau Excel pour lequel je dois comparer des valeurs de seuil (Seveso pour rentrer dans les détails) dans le but d'extraire une valeur de rubrique pour le classement des produits. Le but étant de trouver la valeur minimale des différents seuils et colorer la rubrique correspondante dans une autre feuille de données.

Pour cela mon idée était de calculer le minimum de la plage et de dire que si la valeur minimale était à cette case alors on colore la rubrique correspondante.
Mon problème réside dans le fait qu'un même produit présente parfois des seuils identiques, pour choisir quelle rubrique lui assigner, il faut alors comparer les seuils inférieurs. J'ai donc pensé à calculer le nombre de valeur minimale dans ma plage de données et si ce nombre est supérieur à 1 alors on passe au critère suivant et ainsi de suite..

De plus celà doit s'appliquer à chaque produit rentré par l'utilisateur.. J'ai essayé d'être le plus clair possible, je vous joins le code que j'utilise actuellement qui ne fonctionne pas parfaitement puisqu'il ne colore que la bonne case pour le premier produit..

Dans le code qui suit il faut imaginer que les valeurs de chaque plage sont déjà pré-remplies par la première partie du code que je n'ai pas mise ici :

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
Private Sub Commandbutton2_Click()
 
Dim X As Integer, Y As Integer, A As Integer, B As Integer, answer_haut As Double, nombre As Integer, Z As Integer, valeur As Integer
 
Worksheets("Sheet2").Range("A4:D500").Font.ColorIndex = 1
 
Z = 4
Do
For A = Z To Z + 4
 
Dim myRange_haut As Range
 
    Set myRange_haut = Worksheets("Sheet1").Range("I" & Z & ":K" & Z)
    answer_haut = Application.WorksheetFunction.Min(myRange_haut)
 
Dim myRange_bas As Range
 
    Set myRange_bas = Worksheets("Sheet1").Range("L" & Z & ":N" & Z)
    answer_bas = Application.WorksheetFunction.Min(myRange_bas)
 
Dim myRange_aut As Range
 
    Set myRange_aut = Worksheets("Sheet1").Range("O" & Z & ":Q" & Z)
    answer_aut = Application.WorksheetFunction.Min(myRange_aut)
 
Dim myRange_decl As Range
 
    Set myRange_decl = Worksheets("Sheet1").Range("R" & Z & ":T" & Z)
    answer_decl = Application.WorksheetFunction.Min(myRange_decl)
 
' Les valeurs qui suivent sont le calcul des nombres de valeur minimale pour chaque seuil 
 
Valeur_haut = Worksheets("Sheet2").Cells(Z, "K").Value
Valeur_bas = Worksheets("Sheet2").Cells(Z, "L").Value
Valeur_aut = Worksheets("Sheet2").Cells(Z, "M").Value
Valeur_decl = Worksheets("Sheet2").Cells(Z, "N").Value
 
Select Case (Valeur_haut)
 
Case 1
 
' Si il n'y a qu'un minimum, on peut classer directement le produit en colorant la bonne case dans la Sheet2 :
 
If Worksheets("Sheet1").Range("I" & A).Value = answer_haut Then Worksheets("Sheet2").Range("A" & A).Font.ColorIndex = 4 Else Worksheets("Sheet2").Range("A" & A).Font.ColorIndex = 1
If Worksheets("Sheet1").Range("J" & A).Value = answer_haut Then Worksheets("Sheet2").Range("B" & A).Font.ColorIndex = 4 Else Worksheets("Sheet2").Range("B" & A).Font.ColorIndex = 1
If Worksheets("Sheet1").Range("K" & A).Value = answer_haut Then Worksheets("Sheet2").Range("C" & A).Font.ColorIndex = 4 Else Worksheets("Sheet2").Range("C" & A).Font.ColorIndex = 1
 
Case 2 To 5
 
' Si le nombre de minimum est supérieur à 1 alors il faut passer à l'étude des seuils inférieurs 
 
Select Case (Valeur_bas)
 
Case 1
 
If Worksheets("Sheet1").Range("L" & A).Value = answer_bas Then Worksheets("Sheet2").Range("A" & A).Font.ColorIndex = 4 Else Worksheets("Sheet2").Range("A" & A).Font.ColorIndex = 1
If Worksheets("Sheet1").Range("M" & A).Value = answer_bas Then Worksheets("Sheet2").Range("B" & A).Font.ColorIndex = 4 Else Worksheets("Sheet2").Range("B" & A).Font.ColorIndex = 1
If Worksheets("Sheet1").Range("N" & A).Value = answer_bas Then Worksheets("Sheet2").Range("C" & A).Font.ColorIndex = 4 Else Worksheets("Sheet2").Range("C" & A).Font.ColorIndex = 1
 
Case 2 To 5
 
Select Case (Valeur_aut)
 
Case 1
 
If Worksheets("Sheet1").Range("O" & A).Value = answer_aut Then Worksheets("Sheet2").Range("A" & A).Font.ColorIndex = 4 Else Worksheets("Sheet2").Range("A" & A).Font.ColorIndex = 1
If Worksheets("Sheet1").Range("P" & A).Value = answer_aut Then Worksheets("Sheet2").Range("B" & A).Font.ColorIndex = 4 Else Worksheets("Sheet2").Range("B" & A).Font.ColorIndex = 1
If Worksheets("Sheet1").Range("Q" & A).Value = answer_aut Then Worksheets("Sheet2").Range("C" & A).Font.ColorIndex = 4 Else Worksheets("Sheet2").Range("C" & A).Font.ColorIndex = 1
 
Case 2 To 5
 
Select Case (Valeur_decl)
 
Case 1
 
If Worksheets("Sheet1").Range("R" & A).Value = answer_decl Then Worksheets("Sheet2").Range("A" & A).Font.ColorIndex = 4 Else Worksheets("Sheet2").Range("A" & A).Font.ColorIndex = 1
If Worksheets("Sheet1").Range("S" & A).Value = answer_decl Then Worksheets("Sheet2").Range("B" & A).Font.ColorIndex = 4 Else Worksheets("Sheet2").Range("B" & A).Font.ColorIndex = 1
If Worksheets("Sheet1").Range("T" & A).Value = answer_decl Then Worksheets("Sheet2").Range("C" & A).Font.ColorIndex = 4 Else Worksheets("Sheet2").Range("C" & A).Font.ColorIndex = 1
 
End Select
End Select
End Select
End Select
 
Next
Next
 
Z = Z + 5
 
Loop Until Z >= 40
 
End Sub
Merci par avance si vous arrivez à comprendre le problème..