Discussion :

[DGA71]

Bonjour,
Je reviens vers vous, toujours pour mon même fichier, mais pour une nouvelle fonction qui me serait utile, mais dont je me demande si elle est seulement réalisable. Je préfère avoir votre avis avant de passer des jours à me casser la tête sur quelque chose d'impossible...
J'ai donc un fichier dans lequel les cellules sont colorées (cf images), chaque cellule correspondant à une plage horaire de 10 minutes.

Chaque couleur doit être un multiple d'une durée qui lui est propre (par ex 20 min pour CS Simple en vert clair strié blanc).
J'ai mis un contrôle en bout de ligne (MFC) qui affiche la cellule en rouge si le total de la couleur sur la ligne n'est pas un multiple de la durée prévue (ex : ligne 1). En revanche, si, dans une même ligne, j'ai par exemple pour du CS Simple, une période de 30 minutes puis une autre plus loin de 30 minutes, le total est bon, alors que les deux plages ne le sont pas. (ex : ligne 2)
J'aimerais donc pouvoir, par un bouton, déclencher une vérification de tout le tableau, mais plage par plage, pour m'assurer que la durée de chaque plage soit bonne.
Je pensais faire un test cellule par cellule, avec contrôle de la couleur de la cellule, comparaison avec celle d'après, incrémentation d'un compteur, et à la fin de la plage, vérification de la durée. Mais ça me paraît très (trop) lourd et pas gérable par excel.
Auriez-vous un avis, ou une suggestion?

Merci d'avance.

PS. Normalement ce contrôle est inutile, avec une bonne utilisation du fichier (j'ai mis d'autres contrôles), mais les utilisateurs ne respectent pas les consignes...

[DGA71]

Bon, en faisant des schémas à la main, et en imbriquant des For, Do while, if et select case, j'ai réussi.

[eriiic]

Bonjour,

ça aurait été sympa de faire profiter les futurs lecteurs de ta solution...

En attendant, la mienne :

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
Sub cherche_Format()
    Dim c1 As Range, pl As Range, adr1 As String
    Application.FindFormat.Clear
    With Application.FindFormat.Interior
        .Color = [C2].Interior.Color
        ' ... etc
    End With
    With [C2:Z2]
        Set c1 = .Find(What:="", SearchFormat:=True)
        If Not c1 Is Nothing Then
            adr1 = c1.Address: Set pl = c1
            Do
                Set c1 = .Find(What:="", After:=c1, SearchFormat:=True)
                If c1.Address <> adr1 Then Set pl = Union(pl, c1)
            Loop While Not c1 Is Nothing And c1.Address <> adr1
            For Each pl In pl.Areas
                MsgBox pl.Cells.Count 'restitution
            Next pl
        End If
    End With
End Sub

eric

[DGA71]

Si ça peut intéresser quelqu'un, pas de problème. La voici. Un peu compliqué comme je disais...

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
Sub Verif()
Dim C As Integer, L As Integer, Serie As Integer, CTest As Integer, Erreur As Integer
NbLignes = Application.WorksheetFunction.CountA(ActiveSheet.Range("$A:$A"))
Erreur = 0
For L = 10 To NbLignes + 6
    C = 4
    Do While C <= 75
        Serie = 1
        If Cells(L, C).Interior.ColorIndex <> xlNone Then
            Do While Cells(L, C + 1).Interior.ColorIndex = Cells(L, C).Interior.ColorIndex And C <= 75
                Serie = Serie + 1
                C = C + 1
            Loop
            CTest = 7
            Do While CTest <= 75
                If Cells(5, CTest).Interior.ColorIndex = Cells(L, C).Interior.ColorIndex Then
                    Exit Do
                    Else
                    CTest = CTest + 6
                End If
            Loop
            Select Case CTest
                Case 4 To 7
                    If Serie Mod 2 <> 0 Then
                        Range(Cells(L, C - Serie + 1), Cells(L, C)).Value = "E"
                    End If
                Case 10 To 13
                'CNP - 15 minutes
                    If Serie * 10 Mod 15 <> 0 Then
                        Range(Cells(L, C - Serie + 1), Cells(L, C)).Value = "E"
                        Erreur = 1
                    End If
                Case 16 To 19
                'CST - 20 min
                    If Serie Mod 2 <> 0 Then
                        Range(Cells(L, C - Serie + 1), Cells(L, C)).Value = "E"
                        Erreur = 1
                    End If
                Case 22 To 25
                'VAD urgentes - 30 min
                    If Serie Mod 3 <> 0 Then
                        Range(Cells(L, C - Serie + 1), Cells(L, C)).Value = "E"
                        Erreur = 1
                    End If
                Case 28 To 31
                'VAD - 30 min
                    If Serie Mod 3 <> 0 Then
                        Range(Cells(L, C - Serie + 1), Cells(L, C)).Value = "E"
                        Erreur = 1
                    End If
                Case 34 To 37
                'Cs complexe - 30 min
                    If Serie Mod 3 <> 0 Then
                        Range(Cells(L, C - Serie + 1), Cells(L, C)).Value = "E"
                        Erreur = 1
                    End If
                Case 46 To 49
                'Temps administratif - 30 min
                    If Serie <> 3 Then
                        Range(Cells(L, C - Serie + 1), Cells(L, C)).Value = "E"
                        Erreur = 1
                    End If
                Case Is >= 74
                    Range(Cells(L, C - Serie + 1), Cells(L, C)).Value = "E"
                    Erreur = 1
            End Select
        End If
        C = C + 1
    Loop
Next L
If Erreur = 1 Then
    MsgBox "Le tableau contient des erreurs."
    Else
    MsgBox "Le tableau ne contient aucune erreur."
End If
End Sub