XL 2013 Rendre impossible la saisie de doublons dans un formulaire

Fabianova

XLDnaute Nouveau
Bonjour,

En lisant ce titre beaucoup vont sans doute se dire que ce sujet est déjà résolu sur d'autres discutions mais pour ma part ce n'est pas tout à fait ce que je recherche.

Je voudrais pouvoir non pas vérifier un doublon à la fois mais plusieurs.
1577103705079.png



Les cellules en brun sont celles ou je veux vérifier les doublons. Le matricule peut être identique sur plusieurs lignes mais les dates doivent différer si ce matricule est le même. Ce fichier permet de saisir les missions d'un employé, donc cette employé peut faire plusieurs missions différentes, d'ou le fait que le matricule puisse être le même sur plusieurs lignes, en revanche les dates doivent différer en fonction de ses missions.

Je rentre mes données dans un formulaire et j'aimerai qu'au moment d'appuyer sur le bouton de validation, si un doublon est détecté la saisie soit impossible avec un message le notifiant à l'utilisateur.

Un autre onglet dans le même fichier est sur le même principe mais avec une seule date à la place de deux.

Je vous joint le fichier afin que vous puissiez y jeter un œil!

J’espère avoir été clair dans mes explications, étant débutant sur VBA j'ai des fois du mal à trouver les solutions par moi même alors je scrute les discussions mais malheureusement cette fois ci aucune réponses ne pouvait satisfaire ma requête!

Merci d'avance pour votre aide et bonnes fêtes à tous :)
 

Pièces jointes

  • Fichier Doublon.xlsm
    361.9 KB · Affichages: 13

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Fabianova, bonjour le forum,

Le code modifié du bouton CALCULER :

VB:
Private Sub CommandButton1_Click()
Dim L As Integer
Dim MAK As Double
Dim OM As Worksheet 'déclare la variable OM (Onglet Missions)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim DDL As Date 'déclare la variable DDL (Date Début Ligne)
Dim DFL As Date 'déclare la variable DFL (Date Fin Ligne)
Dim DDU As Date 'déclare la variable DDU (Date Début UserForm)
Dim DFU As Date 'déclare la variable DFU (Date Fin UserForm)
Dim JL As Date 'déclare la variable JL (Jour Ligne)
Dim JU As Date 'déclare la variable JU (Jour UserForm)
Dim TEST As Boolean 'déclare la variable TEST

Set OM = Worksheets("MISSIONS") 'définit l'onglet OM
TV = OM.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
DDU = DateSerial(Year(tbStDate), Month(tbStDate), Day(tbStDate)) 'définit la date de début de l'UserForm DDU
DFU = DateSerial(Year(tbEndDate), Month(tbEndDate), Day(tbEndDate)) 'définit la date de fin de l'UserForm DFU
For I = 3 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la troisième)
    If TV(I, 1) = "" Then GoTo fin 'si la donnée ligne I colonne 1 de TV est vide, va à l'étiquette "fin"
    DDL = DateSerial(Year(TV(I, 18)), Month(TV(I, 18)), Day(TV(I, 18))) 'définit la date de début de la ligne DDL
    DFL = DateSerial(Year(TV(I, 19)), Month(TV(I, 19)), Day(TV(I, 19))) 'définit la date de fin de la ligne DFF
    If CStr(TV(I, 4)) = Me.TextBox1.Value Then 'condition 1 : si les matricules de la ligne et de l'UserForm sont identiques
        For JL = DDL To DFL 'boucle 2 : sur tous les les jours JL de la période de la ligne
            For JU = DDU To DFU 'boucle 3 : sur tous les les jours JU de la période de l'Userform
                If JL = JU Then TEST = True: GoTo suite 'si un des jours se chevauche, définit la variable TEST, va a l'étiquette "suite"
            Next JU 'prochain jour de la boucle 3
        Next JL 'prochain jour de la boucle 2
suite: 'étiquette
        If TEST = True Then 'condition 2 : si TEST est [Vrai]
            MsgBox TV(I, 6) & " " & TV(I, 5) & " est déjà en mission durant cette période !" 'message
            OM.Rows(I).Select 'sélectionne la ligne où la mission se chevauchhe
            Exit Sub 'sort de la procédure
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle
fin: 'étiquette

If Me.PRIME.Value = "" Then
MsgBox "VOUS DEVEZ SAISIR UN MONTANT DE PRIME !"
Me.PRIME.SetFocus
Exit Sub
End If
If MsgBox("Confirmez-vous les données ?", vbYesNo, "Demande de confirmation de calcul") = vbYes Then
    L = Sheets("MISSIONS").Range("A100000").End(xlUp).Row + 1
    Range("A" & L).Value = Enseigne
    Range("B" & L).Value = Val(CodeMag)
    Range("C" & L).Value = NomMag
    Range("D" & L).Value = Val(TextBox1)
    Range("E" & L).Value = Nom
    Range("F" & L).Value = Prénom
    Range("G" & L).Value = Poste
    Range("H" & L).Value = Section
    Range("I" & L).Value = tbStDate1
    Range("J" & L).Value = Enseigne1
    Range("K" & L).Value = NomMag1
    Range("L" & L).Value = Val(TextBox9)
    Range("M" & L).Value = ComboBox1
    Range("N" & L).Value = CheckBox4
    Range("O" & L).Value = CheckBox5
    Range("P" & L).Value = CheckBox6
    Range("R" & L).Value = tbStDate
    Range("S" & L).Value = tbEndDate
    Range("T" & L).Value = Val(PRIME)
End If
MAK = Val(Replace(TextBox1.Value, Format(0, ","), "."))
TextBox1 = MAK
End Sub
 

Fabianova

XLDnaute Nouveau
Bonjour Fabianova, bonjour le forum,

Le code modifié du bouton CALCULER :

VB:
Private Sub CommandButton1_Click()
Dim L As Integer
Dim MAK As Double
Dim OM As Worksheet 'déclare la variable OM (Onglet Missions)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim DDL As Date 'déclare la variable DDL (Date Début Ligne)
Dim DFL As Date 'déclare la variable DFL (Date Fin Ligne)
Dim DDU As Date 'déclare la variable DDU (Date Début UserForm)
Dim DFU As Date 'déclare la variable DFU (Date Fin UserForm)
Dim JL As Date 'déclare la variable JL (Jour Ligne)
Dim JU As Date 'déclare la variable JU (Jour UserForm)
Dim TEST As Boolean 'déclare la variable TEST

Set OM = Worksheets("MISSIONS") 'définit l'onglet OM
TV = OM.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
DDU = DateSerial(Year(tbStDate), Month(tbStDate), Day(tbStDate)) 'définit la date de début de l'UserForm DDU
DFU = DateSerial(Year(tbEndDate), Month(tbEndDate), Day(tbEndDate)) 'définit la date de fin de l'UserForm DFU
For I = 3 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la troisième)
    If TV(I, 1) = "" Then GoTo fin 'si la donnée ligne I colonne 1 de TV est vide, va à l'étiquette "fin"
    DDL = DateSerial(Year(TV(I, 18)), Month(TV(I, 18)), Day(TV(I, 18))) 'définit la date de début de la ligne DDL
    DFL = DateSerial(Year(TV(I, 19)), Month(TV(I, 19)), Day(TV(I, 19))) 'définit la date de fin de la ligne DFF
    If CStr(TV(I, 4)) = Me.TextBox1.Value Then 'condition 1 : si les matricules de la ligne et de l'UserForm sont identiques
        For JL = DDL To DFL 'boucle 2 : sur tous les les jours JL de la période de la ligne
            For JU = DDU To DFU 'boucle 3 : sur tous les les jours JU de la période de l'Userform
                If JL = JU Then TEST = True: GoTo suite 'si un des jours se chevauche, définit la variable TEST, va a l'étiquette "suite"
            Next JU 'prochain jour de la boucle 3
        Next JL 'prochain jour de la boucle 2
suite: 'étiquette
        If TEST = True Then 'condition 2 : si TEST est [Vrai]
            MsgBox TV(I, 6) & " " & TV(I, 5) & " est déjà en mission durant cette période !" 'message
            OM.Rows(I).Select 'sélectionne la ligne où la mission se chevauchhe
            Exit Sub 'sort de la procédure
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle
fin: 'étiquette

If Me.PRIME.Value = "" Then
MsgBox "VOUS DEVEZ SAISIR UN MONTANT DE PRIME !"
Me.PRIME.SetFocus
Exit Sub
End If
If MsgBox("Confirmez-vous les données ?", vbYesNo, "Demande de confirmation de calcul") = vbYes Then
    L = Sheets("MISSIONS").Range("A100000").End(xlUp).Row + 1
    Range("A" & L).Value = Enseigne
    Range("B" & L).Value = Val(CodeMag)
    Range("C" & L).Value = NomMag
    Range("D" & L).Value = Val(TextBox1)
    Range("E" & L).Value = Nom
    Range("F" & L).Value = Prénom
    Range("G" & L).Value = Poste
    Range("H" & L).Value = Section
    Range("I" & L).Value = tbStDate1
    Range("J" & L).Value = Enseigne1
    Range("K" & L).Value = NomMag1
    Range("L" & L).Value = Val(TextBox9)
    Range("M" & L).Value = ComboBox1
    Range("N" & L).Value = CheckBox4
    Range("O" & L).Value = CheckBox5
    Range("P" & L).Value = CheckBox6
    Range("R" & L).Value = tbStDate
    Range("S" & L).Value = tbEndDate
    Range("T" & L).Value = Val(PRIME)
End If
MAK = Val(Replace(TextBox1.Value, Format(0, ","), "."))
TextBox1 = MAK
End Sub

Bonjour Robert,

Désolé pour ma réponse tardive, les fêtes sont passées par là... :)

J'ai essayé d'appliquer le code que tu m'as envoyé, en revanche cela m'affiche un message d'erreur. Etant donné mon niveau plus que débutant en VBA je n'ai pas compris ou pouvait se trouver l'erreur.

Serait-il possible que tu me renvoies mon fichier en PJ avec le code incorporé s'il te plait?

Merci d'avance pour l'aide apportée et bonne journée ;)
 

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour le fil, bonjour le forum,

@JFC : merci pour avoir testé !

@ Fabianova : la version 2 en pièce jointe avec les deux UserForms opérationnels. J'ai remplacé des textboxes par des comboboxes quand ça me paraissait nécessaire. Notamment la Textbox9 par la combobox CoMa. Je n'ai pas compris pourquoi tu allais chercher le code magasin dans l'onglet EFFECTIF et pas dans ListMag, ça me paraît plus logique. Mais si je me trompe tu adapteras...
Le fichier :
 

Pièces jointes

  • Fabianova_ED_v02.xlsm
    366.7 KB · Affichages: 8

jcf6464

XLDnaute Occasionnel
Bonjour Robert, Fabianova et le forum,

Je viens de testé si tu ne rentre pas la date de transmis paie cela plante y pas de contrôle sur la saisie de la date sur la prime cela mache

un textbox1 par un Eff

bonne fin d'année et bonne soirée et pas trop de bulles ;)

jcf
 

Robert

XLDnaute Barbatruc
Repose en paix
Re,

Suite aux judicieuses remarques que Jean-Claude m'a faites et que j'indique ci-dessous :

1-Dans la feuille mission le bouton n'ouvre pas le bon userform,
2- bug dans les deux userform (ligne If CStr(TV(I, 4)) = Me.Eff.Value Then 'condition : si les matricules de la ligne et de l'UserForm sont identiques )
Me.textbox1 que j'ai remplacer par Eff
3- bug dans les deux userform ( Range("E" & L).Value = Nom.Value) supprimer les Value et visible devant Nom et autres champs
4- dans le userform Missions quand on oublie de rentrer la date (Transmis Paie:) il y un bug ligne ( Range("I" & L).Value = DateSerial(Year(tbStDate1), Month(tbStDate1), Day(tbStDate1)))
Voici la version 3 corrigée (enfin j'espère)... Mais bon jean-Claude, je t'avoue que sans plus aucune nouvelle de Fibianova je ne vois plus l'intérêt de continuer à me casser la nénette pour lui...
 

Pièces jointes

  • Fabianova_ED_v03.xlsm
    373.1 KB · Affichages: 17

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou