Macro "Anti doublon" à intégrer dans une autre macro

Yopub

XLDnaute Junior
Bonjour tout le monde, j'aimerais intégrer une "Private Sub Worksheet_Change" dans une macro déclenchée par un bouton.
La private sub permet d'éviter les doublons, et fonctionne parfaitement :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

'colonne à "surveiller" (ici colonne c)
If Target.Column = 3 Then

' pour vérifier si la saisie n'existe pas déjà dans les lignes précédentes
If Application.WorksheetFunction. _
CountIf(Range(Cells(2, 1), _
Cells(Target.Row, 1)), Target.Value) > 1 Then

MsgBox "Nom déjà utilisé, ajoutez l'initiale du prénom en plus"
Target.Value = ""
Target.Select
End If
End If
End Sub

Le problème est que la macro globale marque une pause pour générer la fenêtre "anti doublon" mais reprend après avoir fait ok.
Comment puis-je intégrer l'apparition de cette fenêtre et lancer une séquence IF ?
Ou alors, ne serait-ce pas plus simple de transformer la Private sub en sub ? Et alors : comment ?

Merci de votre aide

Ci-dessous le début de la macro globale :

Code:
Sub NouvelAgent()

'Active la feuille Récap
Sheets("Récap").Select

' Retire la protection de la feuille Récap en activant la macro appropriée
    OTProtection

Dim NomAgent As String
NomAgent = InputBox("Quel est le NOM de l'Agent ?")

'Permet de trouver la 1ère ligne vide du tableau dans la colonne B
    
    Range("c29").End(xlUp).Offset(1, 0).Range("A1").FormulaR1C1 = NomAgent

                                          'ICI DEVRAIT COMMENCER LA VERIFICATION DOUBLON

'Rend visible la feuille Modèle en vue de copiage
    Sheets("Modèle").Visible = True

'Crée une feuille à partir du modèle et le renomme avec le nom de l'agent
    Sheets("Modèle").Copy After:=Sheets(3)
    Sheets("Modèle (2)").Name = NomAgent
    Range("C3").FormulaR1C1 = NomAgent
 

jp14

XLDnaute Barbatruc
Re : Macro "Anti doublon" à intégrer dans une autre macro

Bonjour

Une piste

Supprimer le message dans "Private Sub Worksheet_Change(ByVal Target As Excel.Range)", le remplacer par un "flag" (sémaphore, indicateur, drapeau) public, qui serait testé dans la procédure Sub NouvelAgent()

Public flag as Boolean

dans la procédure "Private Sub Worksheet_Change(ByVal Target As Excel.Range)" flag =true si doublon

flag = false
Range("c29").End(xlUp).Offset(1, 0).Range("A1").FormulaR1C1 = NomAgent
If flag = true then .......

A tester

JP
 
Dernière édition:

Theze

XLDnaute Occasionnel
Re : Macro "Anti doublon" à intégrer dans une autre macro

Bonjour,

Si ce doit être déclanché par un bouton (et nom par une proc évènementielle) tu peux faire ceci (tiré de ton exemple de code) :
Code:
Private Sub NouvelAgent()

    Dim NomAgent As String

    NomAgent = InputBox("Quel est le NOM de l'Agent ?")

    If NomAgent = "" Then Exit Sub 'si vide, fin

    'recherche en colonne A, si existe, message puis fin
    If Application.WorksheetFunction.CountIf(Range(Cells(2, 1), _
                                             Cells(Rows.Count, 1).End(xlUp)), _
                                             NomAgent) > 1 Then

        MsgBox "Nom déjà utilisé, ajoutez l'initiale du prénom en plus !"
        Exit Sub

    End If

    'arrivé ici, le nom de l'agent n'existe pas, donc...

    'Permet de trouver la 1ère ligne vide du tableau dans la colonne B <-??? tu est sûr ?
    'parce qu'ici c'est "c29" et en plus, on ne sait pas sur quelle feuille ?
    Range("c29").End(xlUp).Offset(1, 0) = NomAgent
    'ce serait mieux de cette façon :
    'Sheets("Feuil1").Range("C65536").End(xlUp).Offset(1, 0) = NomAgent

    'Rend visible la feuille Modèle en vue de copiage
    Sheets("Modèle").Visible = True

    'Crée une feuille à partir du modèle et le renomme avec le nom de l'agent
    Sheets("Modèle").Copy After:=Sheets(3)
    Sheets("Modèle (2)").Name = NomAgent
    Sheets(NomAgent).Range("C3") = NomAgent

End Sub

Hervé.
 

Yopub

XLDnaute Junior
Re : Macro "Anti doublon" à intégrer dans une autre macro

Chers JP et RV, merci de vos réponses. Je me penche aussitôt sur l'une et l'autre version.
Bien vu Hervé pour la colonne, j'ai modifié plusieurs fois le tableau et je n'ai pas mis à jour mes annotations. Quant à la précision de la feuille, je ne l'ai pas jugé utile car le déclenchement de la macro ne peut se faire qu'à partir de cette feuille. Mais bon, dans le doute, la précision ne me tuera pas !
Je vous tiens au courant des résultats.
Au fait, dans ce forum peut-on arrêter le post par un "Sujet résolu" ? Si oui comment ?
 

Yopub

XLDnaute Junior
Re : Macro "Anti doublon" à intégrer dans une autre macro

Alors, Hervé, il y a quelquechose qui coince, puisque rien ne se passe, ni message d'erreur, ni bug de la macro.
2 remarques viennent à l'esprit du grand débutant que je suis et ce dans la même phrase :

'recherche en colonne A, si existe, message puis fin
If Application.WorksheetFunction.CountIf(Range(Cells(2, 1), _
Cells(Rows.Count, 1).End(xlUp)), _
NomAgent) > 1 Then

1)- la recherche doit se faire dans la colonne C,
2)- tu fais appel à une application ou une fonction (Application.WorksheetFunction) si toutefois je comprends bien la phrase. Mais cela ne demande-t-il pas que cette fonction soit définit quelquepart ?

Pour revenir au point 1), j'ai modifié (pour la colonne C à partir de la ligne 4) comme suit :

If Application.WorksheetFunction.CountIf(Range(Cells(4, 3), _
Cells(Rows.Count, 3).End(xlUp)), _
NomAgent) > 1 Then

Mais ça ne change rien, la macro se déroule comme si de rien n'était... Help !
(oui, bon je sais, les débutants c'est gonflant) !
 

Yopub

XLDnaute Junior
Re : Macro "Anti doublon" à intégrer dans une autre macro

JP14, je pense avoir compris le sens de ta proposition :
dans un premier temps il faut modifier la private sub, et déclencher une alerte en cas de doublon (pas un message).
Ensuite, dans la sub, un code doit permettre de réagir à cette alerte afin de s'arrêter et d'ouvrir un message précisant l'erreur et ensuite de revenir à l'ouverture de l'inputbox.
Mais je ne suis pas assez calé pour mettre tout ça sur pied.
Peux-tu m'en dire plus ?
 

jp14

XLDnaute Barbatruc
Re : Macro "Anti doublon" à intégrer dans une autre macro

Bonjour

JP14, je pense avoir compris le sens de ta proposition :
dans un premier temps il faut modifier la private sub, et déclencher une alerte en cas de doublon (pas un message).
Ensuite, dans la sub, un code doit permettre de réagir à cette alerte afin de s'arrêter et d'ouvrir un message précisant l'erreur et ensuite de revenir à l'ouverture de l'inputbox.
Mais je ne suis pas assez calé pour mettre tout ça sur pied.
Peux-tu m'en dire plus ?

Ci dessous un code qui devrait répondre au problème.
Le "MsgBox" est inutile.

Code:
Option Explicit
Public flag As Boolean
Sub NouvelAgent()
Dim Reponse As Variant
Dim dl1 As Long
With Sheets("Récap")
Dim NomAgent As String
Dim Message As String
' Retire la protection de la feuille Récap en activant la macro appropriée
    'OTProtection

NomAgent = ""
Message = "Quel est le NOM de l'Agent ?"
Do
        Reponse = Application.InputBox(Prompt:=Message, Title:="Nouveau Nom", Type:=2, Default:=NomAgent)
        Select Case Reponse
            Case ""
                MsgBox "Vous n'avez pas  fait de saisies!" & Chr(13) & "recommencez!"
            Case False
                Exit Sub
            Case Else
                flag = False
                NomAgent = CStr(Reponse)
                dl1 = .Range("c" & .Rows.Count).End(xlUp).Row + 1
                .Range("c" & dl1) = NomAgent
                If flag = False Then Exit Do
                Message = "Nom déjà utilisé, ajoutez l'initiale du prénom en plus"
                .Range("c" & dl1) = ""
        End Select
 Loop
                                         '
End With

End Sub

La procédure simplifiée
Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'colonne à "surveiller" (ici colonne c)
If Target.Column <> 3 Then Exit Sub
' pour vérifier si la saisie n'existe pas déjà dans les lignes précédentes
If Application.WorksheetFunction.CountIf(Range(Cells(2, Target.Column), Cells(Target.Row, Target.Column)), Target.Value) > 1 Then flag = True
End Sub

A tester

JP
 

Discussions similaires

Statistiques des forums

Discussions
312 502
Messages
2 089 033
Membres
104 010
dernier inscrit
Freba