Capturer Valeur d'une cell si une autre cell n'est pas colorindex = X

[Bernard]

Salut à tout le monde!

j'ai un souci pour terminer mon truc:

c'est un planning calculant les absences en fonction du colorindex
toutes les couleurs des feuilles ont leur fonction, sauf le bleu ciel(37) et le noir
donc le gris (15) est compté
les couleurs s'appliquent grâce à la BO en haut à droite de la fenêtre, après sélection des cells concernées
le compte ne se fait que dans la partie"haute" de la ligne de chaque membre de l'équipe
la partie "basse" est composée des "G" verts(14) pour "Gardes" et n'est pas décomptée
la macro "CheckGardes" du ModuleColor3(tout en bas) vérifie si tous les jours sont couverts par la garde, le msgbox fonctionne bien...
mais voilà: j'aimerai maintenant qu'il me donne le chiffre du jour auquel il manque le fameux "G" vert (14) (dans cet exemple, le 28)

merci d'avance à tous ceux z'et celles qui se pencheront et plancheront là-dessus!!!!!

Bernard

 

[Hervé]

Bonjour

2 macros :

premiere en recherchant le G et deuxieme en controlant la couleur :

Public Sub vev()
Dim trouvég As Range, plage As Range
Dim i As Integer
For i = 5 To 66 Step 2
Set plage = Range(Cells(5, i), Cells(41, i + 1))
Set trouvég = plage.Find("G", LookIn:=xlValues)
If trouvég Is Nothing Then
If MsgBox("Aucune garde n'a été affectée pour la journée du " & Cells(2, i) & vbCrLf & vbCrLf & "Continuer ?", vbYesNo, "Attention...") = vbNo Then
Exit Sub
End If
End If
Next i
End Sub


Public Sub vev2()
Dim plage As Range, c As Range
Dim i As Integer
Dim bon As Boolean

For i = 5 To 66 Step 2
bon = False
Set plage = Range(Cells(5, i), Cells(41, i + 1))
For Each c In plage
If c.Interior.ColorIndex = 14 Then bon = True
Next c
If bon = False Then
If MsgBox("Aucune garde n'a été affectée pour la journée du " & Cells(2, i) & vbCrLf & vbCrLf & "Continuer ?", vbYesNo, "Attention...") = vbNo Then
Exit Sub
End If
End If
Next i

End Sub

Salut
Hervé

 

[Robert]

Bonjour Bernard, Hervé,
Il est possible de modifier le routine CheckGardes pour calculer directement les jours...

Sub CheckGardes()
Dim rng As Range, i As Long, rng2 As Range, i2 As Long
Dim xDay(62) As Boolean
Dim iPos As Integer
Dim sDays As String
Dim iDay As Integer
Dim strMsg As String
For Each rng In ActiveSheet.[E5:BN41]
If rng.Interior.ColorIndex = 14 Then
i = i + 1
iPos = rng.Column - 4
xDay(iPos) = True
End If
Next
For Each rng2 In ActiveSheet.[E2:BN2]
If rng2.Interior.ColorIndex = 15 Then: i2 = i2 + 1
Next
iDay = 0
For iPos = 1 To 62 Step 2
iDay = iDay + 1
If Not xDay(iPos) Then
sDays = sDays & IIf(sDays = "", "", ", ") & Str(iDay)
End If
Next iPos
strMsg = i / 2 & " jours sur" & " " & i2 / 2 & " sont couverts par la garde"
If i <> i2 Then
strMsg = strMsg & Chr(13) & "Jour(s) manquant(s) : " & sDays
End If
MsgBox strMsg
End Sub

@+

 

[Robert]

Rebonjour,
Dans le dernier test If i <> i2 then, il vaut mieux le remplacer par
If sDays <> "" Then car on peut avoir le cas ou il y a eu 2 garde sur le même jour ......

@+

 

[Bernard]

Yeepaaahh!!

Grand MERCI Hervé, c'est nickel !

Ca me permetra de plus d'approfondire (aproffondir(e) / approffondir(e) ??) le .Find que je ne connaît pas bcp

A+
Bernard

 

[Bernard]

Et aussi grand merci à Robert, je vais tester ça de suite!

Bernard

 

[Bernard]

Après avoir testé tout ça, Robert is the winner!
en effet, je préfère sa soluce plutôt que les msgbox répétée,

mais en tous cas, MERCI à vous deux pour vos efforts

j'adore ce forum, ya pas à dire

Bernard