Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Modification de code

luke3300

XLDnaute Impliqué
Bonsoir le forum,

le code suivant me détecte des données manquntes dans un tableau suivant une colonne de "services" défini de la manière suivante: 1 lettre + chiffre(s) (ex: J103).

Code: 
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 = 14
    Derniere_Ligne_Titulaires = 73
    Premiere_Ligne_Remplacants = 11
    Derniere_Ligne_Remplacants = 60
    
    'les services du samedi
    Erase Tab_Sces
    Nbr_Sces = 13
    ReDim Preserve Tab_Sces(1 To 2, 1 To Nbr_Sces) As String
    Tab_Sces(1, 1) = "JS9": Tab_Sces(1, 2) = "JS13": Tab_Sces(1, 3) = "JS20"
    Tab_Sces(1, 4) = "JS21": Tab_Sces(1, 5) = "JS22": Tab_Sces(1, 6) = "JS23"
    Tab_Sces(1, 7) = "HS6": Tab_Sces(1, 8) = "LS1": Tab_Sces(1, 9) = "LS2"
    Tab_Sces(1, 10) = "JS103": Tab_Sces(1, 11) = "JS105": Tab_Sces(1, 12) = "JS202"
    Tab_Sces(1, 13) = "JS205":
                
    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
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & Compteur).Value > "" 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
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & 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
            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 .Range("B" & 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
            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
' Macro enregistrée le 12/04/2005 par PETRE Stéphane
'
End Sub

J'aimerais cependant modifier l'intitulé des "services" et utiliser 2 lettres + chiffre(s) comme JB002.

Lorsque je le modifie dans mon fichier, le déboguage se fait et il me met cette ligne en jaune:

Tab_Sces(1, Nbr_Sces) = UCase(Left(.Range("B" & Compteur).Value, 1) & CInt(Right(.Range("B" & Compteur).Value, Len(.Range("B" & Compteur).Value) - 1)))

Ma question est la suivante: que dois-je modifier dans le code pour qu'il accepte la prise en charge des "services" nommés par 2 lettres et un ou des chiffres?

Le fichier que j'utilise est Ce lien n'existe plus

D'avance un grand merci et bonne soirée àtout le monde.
 
Trier par date Trier par votes
G

Guest

Guest
Re : Modification de code

Bonsoir Luke3300

Si les Services ont toujours 2 lettres et n chiffres après:

Changer le deuxième 1 en 2 dans la ligne.

Code: 
Tab_Sces(1, Nbr_Sces) = UCase(Left(.Range("B" & Compteur).Value, 1) & CInt(Right(.Range("B" & Compteur).Value, Len(.Range("B" & Compteur).Value) -[SIZE=3][COLOR=red][B]2[/B][/COLOR][/SIZE])))

A bientôt
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif

luke3300

XLDnaute Impliqué
Re : Modification de code

Bonjour Hasco, bonjour le forum,

tout d'abord, merci pour ton aide.

Maintenant, il fonctionne à merveille mais il y a encore un hic ... lorsque la détection se fait, il y a une messagebox qui me dit quels services ne sont pas assurés et dans celle-ci, il ne tient pas compte des double lettre. Il ne tient plus compte non plus des données que je mets dans la feuille "remplaçants".

Je suppose qu'il y a encore d'autres choses à adapter mais lesquelles?

Merci d'avance et bon samedi.
 
Vote positif 0 Vote négatif

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Re : Modification de code

Bonjour Luke3300, Hasco, le forum

Il me semble reconnaitre la façon dont est monté ce code
mets un fichier exemple, ce sera beaucoup plus simple à traiter que de décortiquer tout le code

Cordialement, A+
 
Vote positif 0 Vote négatif

luke3300

XLDnaute Impliqué
Re : Modification de code

Bonjour Yeahou, le fichier est exemple est dans le 1er post si tu veux.

Où même là: Ce lien n'existe plus

Merci pour ton aide et bon samedi.
 
Dernière édition:
Vote positif 0 Vote négatif

luke3300

XLDnaute Impliqué
Re : Modification de code

Bonjour Yeahou et le forum,

je l'ai réuppé ici: SuperUploader.net

En fait, j'ai remarqué que lors de la détection des manquants ou des doublons, le code ne tenait pas compte des services intitulés en 2 lettres + chiffres qui sont inscits dans la feuille des remplaçants.

Et lorsque la boîte de dialogue m'averti de ce qu'il manque ou qu'il y a en double, elle ne tient pas compte non plus des 2 lettres + chiffres.

Je suppose que ce doit être aussi des chiffres à changer mais où?? J'essaye depuis hier sans résultats.


Merci pour votre aide et bon dimanche ensoleillé.
 
Vote positif 0 Vote négatif

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Re : Modification de code

il me semble bien avoir codé cela il y a un bon moment.
je souviens plus exactement du fonctionnement, essaie cela
si cela ne fonctionne pas, renvoie moi le code originel avant tes modifs

Code: 
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 = 11
    Derniere_Ligne_Titulaires = 76
    Premiere_Ligne_Remplacants = 11
    Derniere_Ligne_Remplacants = 60
 
    'les services du samedi
    Erase Tab_Sces
    Nbr_Sces = 13
    ReDim Preserve Tab_Sces(1 To 2, 1 To Nbr_Sces) As String
    Tab_Sces(1, 1) = "JS9": Tab_Sces(1, 2) = "JS13": Tab_Sces(1, 3) = "JS20"
    Tab_Sces(1, 4) = "JS21": Tab_Sces(1, 5) = "JS22": Tab_Sces(1, 6) = "JS23"
    Tab_Sces(1, 7) = "HS6": Tab_Sces(1, 8) = "LS1": Tab_Sces(1, 9) = "LS2"
    Tab_Sces(1, 10) = "JS103": Tab_Sces(1, 11) = "JS105": Tab_Sces(1, 12) = "JS202"
    Tab_Sces(1, 13) = "JS205":
 
    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
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & Compteur).Value > "" 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, 2) & CInt(Right(.Range("B" & Compteur).Value, Len(.Range("B" & Compteur).Value) - 2)))
                        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
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & 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
            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 = "S"
            With Sheets(1)
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & 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
            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
' Macro enregistrée le 12/04/2005 par PETRE Stéphane
'
End Sub
 
Vote positif 0 Vote négatif

luke3300

XLDnaute Impliqué
Re : Modification de code

Rebonjour à tous,


épatant Yeahou, cela fonctionne à merveille!!!!

Merci 1000 fois.

J'ai cependant encore une question (si ce n'est pas trop abuser) ... ne pourrait-on pas faire une détection des données invalides par hasard?

Je m'explique: étant donné que l'utilisation des services composés de 2 lettres + chiffres est assez trompeuse, serait-il possible que le code détecte par exemple un service encodé qui n'existe pas? Si j'encode ZZ1 et que celui-ci n'est pas repris dans la colonne des services, il serait bien que la boîte de dialogue l'indique aussi sous "service(s) encodé(s) invalide(s)".

Car en le testant, je me suis trompé sur certains services et évidement, il ne me l'a pas signalé. Jusqu'à présent, il ignore les données erronnées.

On pourrait le compléter avec cette fonction?

Grand merci d'avance Yeahou et surtout pour ta patience.
 
Vote positif 0 Vote négatif

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Re : Modification de code

essaie cela, pas eu le temps de tester
si cela ne marche pas, passe moi un classeur un peu plus rempli
Code: 
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 = 11
    Derniere_Ligne_Titulaires = 76
    Premiere_Ligne_Remplacants = 11
    Derniere_Ligne_Remplacants = 60
    
    'les services du samedi
    Erase Tab_Sces
    Nbr_Sces = 13
    ReDim Preserve Tab_Sces(1 To 2, 1 To Nbr_Sces) As String
    Tab_Sces(1, 1) = "JS9": Tab_Sces(1, 2) = "JS13": Tab_Sces(1, 3) = "JS20"
    Tab_Sces(1, 4) = "JS21": Tab_Sces(1, 5) = "JS22": Tab_Sces(1, 6) = "JS23"
    Tab_Sces(1, 7) = "HS6": Tab_Sces(1, 8) = "LS1": Tab_Sces(1, 9) = "LS2"
    Tab_Sces(1, 10) = "JS103": Tab_Sces(1, 11) = "JS105": Tab_Sces(1, 12) = "JS202"
    Tab_Sces(1, 13) = "JS205":
                
    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
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & Compteur).Value > "" 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
                            Test = False
                            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
                                    Test = True
                                End If
                            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) _
                                & "Service erroné détecté" & Chr(10) & 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))), vbOKOnly _
                                + vbExclamation
                                Exit Sub
                            End If
                        End If
                    End If
                Next Compteur
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & Compteur).Value > "" 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, 2) & CInt(Right(.Range("B" & Compteur).Value, Len(.Range("B" & Compteur).Value) - 2)))
                        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
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & 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
            With Sheets(2)
                For Compteur = Premiere_Ligne_Remplacants To Derniere_Ligne_Remplacants 'lignes testées
                    If .Range("B" & Compteur).Value > "" 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
                            Test = False
                            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
                                    Test = True
                                End If
                            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) _
                                & "Service erroné détecté" & Chr(10) & 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))), vbOKOnly _
                                + vbExclamation
                                Exit Sub
                            End If
                        End If
                    End If
                Next Compteur
                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) & Chr(10) & Chr(10) & "Service(s) erroné(s):" & _
                Chr(10) & Msg_String(3), vbOKOnly + vbExclamation
            End If
        Case Is = "S"
            With Sheets(1)
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & Compteur).Value > "" 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
                            Test = False
                            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
                                    Test = True
                                End If
                            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) _
                                & "Service erroné détecté" & Chr(10) & 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))), vbOKOnly _
                                + vbExclamation
                                Exit Sub
                            End If
                        End If
                    End If
                Next Compteur
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & 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
            With Sheets(2)
                For Compteur = Premiere_Ligne_Remplacants To Derniere_Ligne_Remplacants 'lignes testées
                    If .Range("B" & Compteur).Value > "" 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
                            Test = False
                            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
                                    Test = True
                                End If
                            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) _
                                & "Service erroné détecté" & Chr(10) & 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))), vbOKOnly _
                                + vbExclamation
                                Exit Sub
                            End If
                        End If
                    End If
                Next Compteur
                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) & Chr(10) & Chr(10) & "Service(s) erroné(s):" & _
                Chr(10) & Msg_String(3), 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
' Macro enregistrée le 12/04/2005 par PETRE Stéphane
'
End Sub
 
Vote positif 0 Vote négatif

luke3300

XLDnaute Impliqué
Re : Modification de code

Merci Yeahou,

voilà j'ai testé mais le déboguage se fait sur cette ligne:

If IsNumeric(Right(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value, Len(.Range("B" & Compteur).Offset(0, Colonne_Test - 2).Value) - 2)) Then

J'ai uppé le fichier complété en partie là: SuperUploader.net

Ce sera plus commode pour toi.

Bon appétit ;-)
 
Vote positif 0 Vote négatif

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Re : Modification de code

essaie cela pour voir si cela te convient
Code: 
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 = 11
    Derniere_Ligne_Titulaires = 76
    Premiere_Ligne_Remplacants = 11
    Derniere_Ligne_Remplacants = 60
 
    'les services du samedi
    Erase Tab_Sces
    Nbr_Sces = 13
    ReDim Preserve Tab_Sces(1 To 2, 1 To Nbr_Sces) As String
    Tab_Sces(1, 1) = "JS9": Tab_Sces(1, 2) = "JS13": Tab_Sces(1, 3) = "JS20"
    Tab_Sces(1, 4) = "JS21": Tab_Sces(1, 5) = "JS22": Tab_Sces(1, 6) = "JS23"
    Tab_Sces(1, 7) = "HS6": Tab_Sces(1, 8) = "LS1": Tab_Sces(1, 9) = "LS2"
    Tab_Sces(1, 10) = "JS103": Tab_Sces(1, 11) = "JS105": Tab_Sces(1, 12) = "JS202"
    Tab_Sces(1, 13) = "JS205":
 
    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
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & Compteur).Value > "" 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, 2) & CInt(Right(.Range("B" & Compteur).Value, Len(.Range("B" & Compteur).Value) - 2)))
                        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
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & 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
            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
                            Test = True
                            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"
                                    Test = False
                                End If
                            Next Compteur2
                            If Test = True Then
                                MsgBox "Jour: " & ActiveSheet.Range("B6").Offset(0, Colonne_Test - 2).Value _
                                & " " & ActiveSheet.Range("B6").Offset(1, Colonne_Test - 2).Value & Chr(10) _
                                & "Service erroné détecté" & Chr(10) & 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))), vbOKOnly _
                                + vbExclamation
                                Exit Sub
                            End If
                        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 .Range("B" & 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
            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
                            Test = True
                            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"
                                    Test = False
                                End If
                            Next Compteur2
                            If Test = True Then
                                MsgBox "Jour: " & ActiveSheet.Range("B6").Offset(0, Colonne_Test - 2).Value _
                                & " " & ActiveSheet.Range("B6").Offset(1, Colonne_Test - 2).Value & Chr(10) _
                                & "Service erroné détecté" & Chr(10) & 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))), vbOKOnly _
                                + vbExclamation
                                Exit Sub
                            End If
                        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
' Macro enregistrée le 12/04/2005 par PETRE Stéphane
'
End Sub
 
Vote positif 0 Vote négatif

luke3300

XLDnaute Impliqué
Re : Modification de code

Bonsoir Yeahou et le forum,

tout à l'air de marcher impeccablement ! Merci beaucoup.

J'ai remarqué en le testant que lorsqu'il détecte des données erronnées, il ne les affiche qu'une seule à la fois. Pourrait-il les afficher toutes en même temps ainsi que leur localisation? Par exemple si j'ai introduis une erreur en D22 et en D25, qu'il me dise "données invalides introduites en D22 et D25: ... ".
Je demande beaucoup je sais mais je dois rendre l'utilisation de mon fichier le plus simple possible si je veux qu'il me facilite la tâche un maximum.

Cela avance à grand pas et c'est déjà grâce à toi.

Encore merci Yeahou et bonne soirée.
 
Vote positif 0 Vote négatif

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Re : Modification de code

et une nouvelle version, une !
Code: 
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 Nbr_Erreurs As Integer, Tab_Erreurs() As String
    Dim Msg_String(1 To 3) 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 = 11
    Derniere_Ligne_Titulaires = 76
    Premiere_Ligne_Remplacants = 11
    Derniere_Ligne_Remplacants = 60
 
    'les services du samedi
    Erase Tab_Sces
    Nbr_Sces = 13
    ReDim Preserve Tab_Sces(1 To 2, 1 To Nbr_Sces) As String
    Tab_Sces(1, 1) = "JS9": Tab_Sces(1, 2) = "JS13": Tab_Sces(1, 3) = "JS20"
    Tab_Sces(1, 4) = "JS21": Tab_Sces(1, 5) = "JS22": Tab_Sces(1, 6) = "JS23"
    Tab_Sces(1, 7) = "HS6": Tab_Sces(1, 8) = "LS1": Tab_Sces(1, 9) = "LS2"
    Tab_Sces(1, 10) = "JS103": Tab_Sces(1, 11) = "JS105": Tab_Sces(1, 12) = "JS202"
    Tab_Sces(1, 13) = "JS205":
 
    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
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & Compteur).Value > "" 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, 2) & CInt(Right(.Range("B" & Compteur).Value, Len(.Range("B" & Compteur).Value) - 2)))
                        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
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & 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
            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
                            Test = True
                            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"
                                    Test = False
                                End If
                            Next Compteur2
                            If Test = True Then
                                Nbr_Erreurs = Nbr_Erreurs + 1
                                ReDim Preserve Tab_Erreurs(1 To Nbr_Erreurs) As String
                                Tab_Erreurs(Nbr_Erreurs) = 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))) & " en " & .Range("B" & Compteur).Offset(0, Colonne_Test - 2).Address
                            End If
                        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
            For Compteur2 = 1 To Nbr_Erreurs
                If Msg_String(3) = "" Then
                    Msg_String(3) = Tab_Erreurs(Compteur2)
                Else
                    Msg_String(3) = Msg_String(3) & Chr(10) & Tab_Erreurs(Compteur2)
                End If
                Test = True
            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) & 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) & Chr(10) & Chr(10) & "Service(s) erroné(s):" & _
                Chr(10) & Msg_String(3), vbOKOnly + vbExclamation
            End If
        Case Is = "S"
            With Sheets(1)
                For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires 'lignes testées
                    If .Range("B" & 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
            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
                            Test = True
                            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"
                                    Test = False
                                End If
                            Next Compteur2
                            If Test = True Then
                                Nbr_Erreurs = Nbr_Erreurs + 1
                                ReDim Preserve Tab_Erreurs(1 To Nbr_Erreurs) As String
                                Tab_Erreurs(Nbr_Erreurs) = 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))) & " en " & .Range("B" & Compteur).Offset(0, Colonne_Test - 2).Address
                            End If
                        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
            For Compteur2 = 1 To Nbr_Erreurs
                If Msg_String(3) = "" Then
                    Msg_String(3) = Tab_Erreurs(Compteur2)
                Else
                    Msg_String(3) = Msg_String(3) & Chr(10) & Tab_Erreurs(Compteur2)
                End If
                Test = True
            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) & 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) & Chr(10) & Chr(10) & "Service(s) erroné(s):" & _
                Chr(10) & Msg_String(3), 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
' Macro enregistrée le 12/04/2005 par PETRE Stéphane
'
End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Question
XL 2021 Création et adaptation barre de progression
2 3
Réponses
44
Affichages
895
Tartine
T
D
  • Résolu(e)
XL 2021 arrondi nombre de jours
Réponses
6
Affichages
424
Did25
D
G
  • Question
Microsoft 365 Export données
Réponses
4
Affichages
356
GClaire
G
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
773
Nicolas JACQUIN
Z
  • Résolu(e)
Microsoft 365 Problème de combinaison entre fonctions "If Then Else" et "SelectCase"
Réponses
11
Affichages
458
Zonmé
Z
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
409
AtTheOne
M
  • Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
261
Gégé-45550
C
  • Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
261
CathyLD
C
C
  • Résolu(e)
XL 2016 Répartir dans des Groupes d'Effectifs Aléatoires ... mais pas trop
Réponses
2
Affichages
167
crocrocro
C
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
1 K
thivame
T
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…