Adapter un code VBA pour étendre les critères de recherche

Bonjour le forum,

J'ai un fichier avec une macro qui m'aide à détecter des "X" (qui équivalent aux valeurs de la colonne B) dans les différentes colonnes. J'aimerais que cette macro détecte en plus des "X", les intitulés de la colonne B. J'essaye sans succès depuis un bout de temps mais je désespère il me semble que cela devrait être possible pourtant. Pourriez-vous m'aider s'il vous plait?

D'avance merci et un excellent w-e à tous.

Bonjour,

Peux tu nous dire où dans ton code il faut t'aider,

Je viens de jeter un oeil et comme tu connais ton code bien mieux que nous, il faudrait que tu nous dises ou tu veux rajouter ton "extension" de recherche et ce que tu veux obtenir avec cette recherche

Bonjour SylChat et merci pour ton intervention.

Ce n'est pas moi qui ai fait ce code (on me l'a fait) et donc je ne sais pas où il faut le modifier ... je suppose que c'est au niveau de ceci:

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

A vrai dire, je n'y connais pas grand chose voir rien en VBA. Je suis juste parvenu à modifier l'étendue de la détection au niveau de la plage et l'un ou l'autre petit truc mais sans plus ...

Ce que j'aimerais obtenir, c'est que lorsque je clique sur mon bouton "Détection" (en haut à G), la macro me détecte dans la colonne choisie, si tous les intitulés repris en B sont comptabilisés soit via une X (pour le personnel titulaire présent) soit par un intitulé (par exemple J201) que l'on retrouve dans la colonne B.

Pour explication de la macro: celle-ci détecte si tous (on va dire) les services repris en colonne B sont assurés. Si ce n'est pas le cas, un messagebox me prévient que des services non assurés et ceux qui ont été assignés plusieurs fois.

Actuellement pour l'onglet "Titulaires", la macro ne tient compte que des X et pas des intitulés comme les J201, J202, etc ... repris en colonne B. Mais il le fait pour l'autre onglet masqué (Remplaçants).

Merci pour votre aide.

Je peux ajouter que dans le code, il y a un "With Sheets(2)" pour un onglet que je n'utilise plus et qui lui, prend en compte les valeurs de la colonne B de l'onglet "Titulaires" pour la détection. Sur l'onglet masqué "Remplaçants", ça fonctionne à merveille.

Bon ben voilà ... j'ai cherché encore et encore et je suis parvenu à obtenir en grande partie ce que je voulais ... car pour le samedi, la macro ne détecte pas plus loin que le nombre d'intitulé qu'il y a dans la colonne B. Hors j'aimerais qu'elle détecte jusqu'à la ligne 200.

Quelqu'un peut-il me dire ce que je dois modifier dans le code ci-dessous pour que le samedi, la détection se fasse jusqu'à la ligne 200 et ne se limite plus à rechercher uniquement jusqu'à hauteur de la dernière valeur de la colonne B? Il me semble que ce qu'il faut modifier est dans la partie entre les **********???

Voici mon 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 = 8
Derniere_Ligne_Titulaires = 200
Premiere_Ligne_Remplacants = 10
Derniere_Ligne_Remplacants = 75

'les services du samedi
Erase Tab_Sces
Nbr_Sces = 3
ReDim Preserve Tab_Sces(1 To 2, 1 To Nbr_Sces) As String
Tab_Sces(1, 1) = "JS202": Tab_Sces(1, 2) = "JS204": Tab_Sces(1, 3) = "JS207"

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
For Compteur = Premiere_Ligne_Titulaires To Derniere_Ligne_Titulaires '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
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
'
'
End Sub

Merci d'avance et bon dimanche.

Bonjour

Pas sur d'avoir bien tout compris

A vérifier et à dire ce qui ne va pas

Bonjour Banzai64 et merci pour ton aide.

Il semble que les valeurs entrées à partir de la colonne C et après la dernière ligne complétée en colonne B ne réagissent pas. Pour les cases du samedi, la macro dit que tout est OK alors que rien n'est complété ...

Pas simple hein

Bonjour

Mal précisé ma question

Tu as bien dit ce qui ne vas pas, mais fais un exemple de ce que tu fais afin que je voies bien ce qui ne va pas

A te lire

Voilà, je viens de compléter correctement le fichier test que j'ai réussi à faire fonctionner correctement pour les jours de semaine. Regardes Bonzai 64, tu comprendras mieux mon souhait pour les samedis car il n'y a plus que là que ça me pose problème ... pour fonctionner correctement, il t esuffit de cliquer dans une des cases de la colonne du samedi et tu verras ce que la macro te révèle par rapport à la réalité.

Merci à toi, excellente soirée.

Bonjour

Joins la dernière version car dans celle ci il n'y avait pas la macro

A tester

Super Banzai64, c'est exactement ce que je désirais mais peux-tu m"indiquer ce qui est a adapter dans le code pour qu'il fonctionne comme ça?

Encore merci

Bonsoir

Steph242 a écrit :

mais peux-tu m"indiquer ce qui est a adapter dans le code pour qu'il fonctionne comme ça?

J'ai repensé le code et cela serait trop long à tout expliquer

Une bonne partie du code existant + plus quelques remarques devraient te permettre de suivre le cheminement de la macro

Grosso modo

De la première à la dernière ligne

Si pas "Samedi" on regarde en colonne B si le service existe déjà (non alors on le place dans le tableau)

ensuite on vérifie si dans la colonne test il y a un "X" si OUI on incrémente le nombre de "X" dans le tableau, si NON on recherche en colonne test le service et dans l'affirmative on augmente le nombre de "X" dans le tableau

Si Samedi on vérifie dans la colonne test si le service prévu le Samedi existe et dans l'affirmative on augmente le nombre de "X" dans le tableau

Ensuite on construit le message en fonction des services et du nombre de fois que l'on a trouvé ce service

Voilà c'est succinct mais c'est le principe

Un tout grand merci Bonzai64, je vais éplucher ça à l'aise.

Bonne journée.