Sub Detecte_NC()
Dim Compteur As Long, Compteur2 As Long, Colonne_Test As Integer
Dim Tab_Sces() As String, Nbr_Sces As Integer, Test As Boolean
Dim Msg_String(1 To 2) As String
Dim Premiere_Ligne_Titulaires As Long, Derniere_Ligne_Titulaires As Long
Dim Premiere_Ligne_Remplacants As Long, Derniere_Ligne_Remplacants As Long
'Définition des lignes à tester
Premiere_Ligne_Titulaires = 8
Derniere_Ligne_Titulaires = 200
Premiere_Ligne_Remplacants = 10
Derniere_Ligne_Remplacants = 75
'les services du samedi
Erase Tab_Sces
Nbr_Sces = 21
ReDim Preserve Tab_Sces(1 To 2, 1 To Nbr_Sces) As String
Tab_Sces(1, 1) = "JS2": Tab_Sces(1, 2) = "JS11": Tab_Sces(1, 3) = "JS13"
Tab_Sces(1, 4) = "JS16": Tab_Sces(1, 5) = "JS21": Tab_Sces(1, 6) = "JS22"
Tab_Sces(1, 7) = "JS24": Tab_Sces(1, 8) = "JS26": Tab_Sces(1, 9) = "JS36"
Tab_Sces(1, 10) = "JS38": Tab_Sces(1, 11) = "JS39": Tab_Sces(1, 12) = "JS42"
Tab_Sces(1, 13) = "JS48": Tab_Sces(1, 14) = "JS49": Tab_Sces(1, 15) = "JS52"
Tab_Sces(1, 16) = "CS1": Tab_Sces(1, 17) = "CS2": Tab_Sces(1, 18) = "JS304"
Tab_Sces(1, 19) = "JS305": Tab_Sces(1, 20) = "JS306": Tab_Sces(1, 21) = "JS307"
Application.ScreenUpdating = False
Colonne_Test = ActiveCell.Column
Select Case Range("A6").Offset(0, Colonne_Test - 1).Value
Case Is = "L", "M", "J", "V"
With Sheets(1)
Erase Tab_Sces
Nbr_Sces = 0
'Liste des services
For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
If .Range("B" & Compteur).Value > "" And Not (Intersect(.Range("B" & Compteur), .Range("B" & Premiere_Ligne_Titulaires & ":B" & Derniere_Ligne_Titulaires).SpecialCells(xlCellTypeVisible)) Is Nothing) = True Then
Nbr_Sces = Nbr_Sces + 1
ReDim Preserve Tab_Sces(1 To 2, 1 To Nbr_Sces) As String
Tab_Sces(1, Nbr_Sces) = UCase(Left(.Range("B" & Compteur).Value, 1) & CInt(Right(.Range("B" & Compteur).Value, Len(.Range("B" & Compteur).Value) - 1)))
If .Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value = "X" Then Tab_Sces(2, Nbr_Sces) = Tab_Sces(2, Nbr_Sces) & "X"
End If
Next Compteur
'Test
For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
If Len(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value) > 1 Then
If IsNumeric(Right(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value, Len(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value) - 1)) Then
For Compteur2 = 1 To Nbr_Sces
If UCase(Left(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value, 1) & CDec(Right(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value, Len(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value) - 1))) = Tab_Sces(1, Compteur2) Then
Tab_Sces(2, Compteur2) = Tab_Sces(2, Compteur2) & "X"
End If
Next Compteur2
End If
End If
Next Compteur
End With
With Sheets(2)
For Compteur = Premiere_Ligne_Remplacants To Derniere_Ligne_Remplacants 'lignes testées
If .Range("A" & Compteur).Value > "" And Len(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value) > 1 Then
If IsNumeric(Right(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value, Len(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value) - 1)) Then
For Compteur2 = 1 To Nbr_Sces
If UCase(Left(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value, 1) & CDec(Right(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value, Len(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value) - 1))) = Tab_Sces(1, Compteur2) Then
Tab_Sces(2, Compteur2) = Tab_Sces(2, Compteur2) & "X"
End If
Next Compteur2
End If
End If
Next Compteur
End With
Test = False
For Compteur2 = 1 To Nbr_Sces
Select Case Len(Tab_Sces(2, Compteur2))
Case Is = 0
Test = True
Msg_String(1) = Msg_String(1) & " " & Tab_Sces(1, Compteur2)
Case Is > 1
Test = True
Msg_String(2) = Msg_String(2) & " " & Tab_Sces(1, Compteur2)
Case Else
End Select
Next Compteur2
If Test = False Then
MsgBox "Jour: " & ActiveSheet.Range("B6").Offset(0, Colonne_Test - 2).Value _
& " " & ActiveSheet.Range("B6").Offset(1, Colonne_Test - 2).Value & Chr(10) _
& "Aucune erreur détectée.", vbOKOnly + vbExclamation
Else
MsgBox "Jour: " & ActiveSheet.Range("B6").Offset(0, Colonne_Test - 2).Value _
& " " & ActiveSheet.Range("B6").Offset(1, Colonne_Test - 2).Value & Chr(10) _
& "service(s) non affecté(s):" & Chr(10) & Msg_String(1) _
& Chr(10) & Chr(10) & "Service(s) affecté(s) plus d'une fois:" & _
Chr(10) & Msg_String(2), vbOKOnly + vbExclamation
End If
Case Is = "S"
With Sheets(1)
For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
If Len(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value) > 1 Then
If IsNumeric(Right(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value, Len(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value) - 2)) Then
For Compteur2 = 1 To Nbr_Sces
If UCase(Left(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value, 2) & CDec(Right(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value, Len(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value) - 2))) = Tab_Sces(1, Compteur2) Then
Tab_Sces(2, Compteur2) = Tab_Sces(2, Compteur2) & "X"
End If
Next Compteur2
End If
End If
Next Compteur
End With
With Sheets(2)
For Compteur = Premiere_Ligne_Remplacants To Derniere_Ligne_Remplacants 'lignes testées
If .Range("A" & Compteur).Value > "" And Len(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value) > 1 Then
If IsNumeric(Right(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value, Len(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value) - 2)) Then
For Compteur2 = 1 To Nbr_Sces
If UCase(Left(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value, 2) & CDec(Right(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value, Len(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value) - 2))) = Tab_Sces(1, Compteur2) Then
Tab_Sces(2, Compteur2) = Tab_Sces(2, Compteur2) & "X"
End If
Next Compteur2
End If
End If
Next Compteur
End With
Test = False
For Compteur2 = 1 To Nbr_Sces
Select Case Len(Tab_Sces(2, Compteur2))
Case Is = 0
Test = True
Msg_String(1) = Msg_String(1) & " " & Tab_Sces(1, Compteur2)
Case Is > 1
Test = True
Msg_String(2) = Msg_String(2) & " " & Tab_Sces(1, Compteur2)
Case Else
End Select
Next Compteur2
If Test = False Then
MsgBox "Jour: " & ActiveSheet.Range("B6").Offset(0, Colonne_Test - 2).Value _
& " " & ActiveSheet.Range("B6").Offset(1, Colonne_Test - 2).Value & Chr(10) _
& "Aucune erreur détectée.", vbOKOnly + vbExclamation
Else
MsgBox "Jour: " & ActiveSheet.Range("B6").Offset(0, Colonne_Test - 2).Value _
& " " & ActiveSheet.Range("B6").Offset(1, Colonne_Test - 2).Value & Chr(10) _
& "Service(s) non affecté(s):" & Chr(10) & Msg_String(1) _
& Chr(10) & Chr(10) & "Service(s) affecté(s) plus d'une fois:" & _
Chr(10) & Msg_String(2), vbOKOnly + vbExclamation
End If
Case Is = "D"
MsgBox "Hé Ho? ça va pas la tête ... c'est dimanche là!!!", vbInformation
Case Else
End Select
'
' Detecte_NC Macro
'
End Sub