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).
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.
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.