Discussion :

[meryn]

Bonsoir ! je me demandais si il étais possible d'avoir un programme qui permet à ma feuille de refuser un double de donnée si celui-ci existe déjà. par un code vba qui s'exécute automatiquement. j'ai essayé la procédure excel des doublons mais ça marche pas vraiment.
Merci ! bonne soirée.

[mercatog]

j'ai essayé la procédure excel des doublons mais ça marche pas vraiment.

Laquelle?

Sinon, pour éviter la saisie d'une donnée en double en colonne A, ci-après code à mettre dans le module de la feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Target.Column = 1 And Target.Count = 1 Then
    If Application.CountIf(Range("A:A"), Target.Value) > 1 Then Application.Undo
End If
End Sub

[meryn]

bonsoir ! merci, je viens de l’essayer, . le code à l'air d'être le bon juste à la fin il se plante , disant il ya un code d'erreur .

dans mon userform j'ai taper dans ma zone de texte le même mot étant dans la feuille. juste à la dernière lettre apparaît un code d'erreur qui me demande " un débogage ou d'y mettre fin".

[SfJ5Rpw8]

Et ce message d'erreur , qu'attends tu pour le lire t le copier ici ?

[meryn]

Erreur d'exécution '1004':

La méthode 'Undo' de l'objet'_Application' a échoué

[mercatog]

Dans ton post #1, tu n'as pas parlé de ton userform.

Sinon, dans le bouton de validation des données inscrites dans les contrôles de ton userform, et avant de les rapatrier sur ta feuille, mets un test de type:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub CommandButton1_Click() 'bouton de validation
 
With Worksheets("Feuil1")
    If Application.CountIf(.Range("A:A"), Me.TextBox1.Value) > 0 Then
        MsgBox Me.TextBox1 & " existe déjà dans la colonne A de la feuille Feuil1"
    Else
        .Cells(.Rows.Count, 1).End(xlUp)(2) = Me.TextBox1
    End If
End With
End Sub

[meryn]

Bonsoir ! je l'ai associé à ce code elle marche quasiment bien, juste que quand j'insert un mail qui n'existe pas dans ma feuille il répète comme même le message "existe déjà dans la colonne A de la feuille "*.* "

est il possible par ce code d'éssayé de voir ou conviendrait que je mettes le code pour quelle marche bien.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Private Sub Ajout1_Click()
If Not (isMailPerso(UserForm1.TextBox1.Text)) Then
       Call MsgBox("Ceci est un destinataire Professionnel" & Chr(10) & _
                   "Veuillez saisir l'adresse mail dans la rubrique appropriée", vbExclamation + vbOKOnly)
       Exit Sub
    End If
'teste si un texte a été entré, si non, le programme averti l'utilisateur et s'arrête
If UserForm1.TextBox1.Text = "" Then
  MsgBox "Vous n'avez rien saisi;" & Chr(10) & "Veillez entrer un mail! "
  Exit Sub
                   End If
For i = 1 To 10000
If Cells(i, 1) = "" Then Exit For
Next
'insertion de la valeur de la zone de texte (textbox1 représentant le nom de la zone de texte)
Cells(i, 1) = TextBox1.Text
MsgBox "Enregistrement de l'adresse Mail créé avec succès"
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Private Sub Ajout2_Click()
If (isMailPerso(UserForm1.TextBox2.Text)) Then
       Call MsgBox("Ceci est un destinataire NON professionnel" & Chr(10) & _
                   "Veuillez saisir l'adresse mail dans la rubrique appropriée", vbExclamation + vbOKOnly)
       Exit Sub
    End If
'teste si un texte a été entré, si non, le programme averti l'utilisateur et s'arrête
               If UserForm1.TextBox2.Text = "" Then
                        MsgBox "Vous n'avez rien saisi;" & Chr(10) & "Veillez entrer un mail! "
                    Exit Sub
                   End If
For i = 1 To 10000
If Cells(i, 1) = "" Then Exit For
Next
 
'insertion de la valeur de la zone de texte (textbox1 représentant le nom de la zone de texte)
Cells(i, 1) = TextBox2.Text
MsgBox "Enregistrement de l'adresse Mail créé avec succès"
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Private Sub CommandButton1_Click()
Unload Me
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub TextBox1_Change()
Sheets("Mail Personnel").Select
Range("A2").Select
ActiveCell.FormulaR1C1 = TextBox1
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub TextBox2_Change()
Sheets("Mail Professionel").Select
Range("A2").Select
ActiveCell.FormulaR1C1 = TextBox2
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Function isMailPerso(destinataire As String) As Boolean
    Dim ISPPerso() As String
    ISPPerso = Split("yahoo;gmail;hotmail;live;voila;laposte;aol;bouygtel;crocomail;caramail", ";")
 
    isMailPerso = False
    Dim i As Integer
    For i = 0 To UBound(ISPPerso)
        If InStr(1, LCase(destinataire), "@" & ISPPerso(i)) > 0 Then
            isMailPerso = True
            Exit For
        End If
    Next i
 
End Function

[mercatog]

Je ferai comme ceci

Je supprime les code TextBox1_Change et TextBox2_Change
Je ferai une seule procédure de transfert
J'ai modifié la procédure isMailPerso

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Option Explicit
 
Private Sub Ajout1_Click()
 
Transfere Me.TextBox1.Text, True
End Sub
 
Private Sub Ajout2_Click()
 
Transfere Me.TextBox2.Text, False
End Sub
 
'Perso=True: mail personnel, Perso=False: Mail professionnel
Private Sub Transfere(ByVal LeMail As String, ByVal Perso As Boolean)
Dim NomFeuille As String, Tpe As String
 
 
NomFeuille = IIf(Perso, "Mail Personnel", "Mail Professionnel")
Tpe = IIf(Perso, "Professionnel", "Personnel")
If LeMail <> "" Then
    If isMailPerso(LeMail) = Perso Then
        With Worksheets("Mail " & Tpe)
            If Nouveau(.Name, LeMail) Then
                'insertion de la valeur de la zone de texte (textbox1 représentant le nom de la zone de texte)
                .Cells(.Rows.Count, 1).End(xlUp)(2) = LeMail
                MsgBox "Enregistrement de l'adresse Mail créé avec succès"
            Else
                MsgBox "Destinataire existe déjà"
 
            End If
        End With
    Else
        MsgBox "Ceci est un destinataire " & Tpe & Chr(10) & "Veuillez saisir l'adresse mail dans la rubrique appropriée", vbExclamation + vbOKOnly
    End If
Else
    MsgBox "Vous n'avez rien saisi;" & Chr(10) & "Veillez entrer un mail! "
End If
End Sub
 
Private Function isMailPerso(ByVal Dest As String) As Boolean
Dim ISPPerso As String
Dim i As Integer
 
ISPPerso = ";yahoo;gmail;hotmail;live;voila;laposte;aol;bouygtel;crocomail;caramail;" 'le ; à la fin est nécessaire
Dest = Mid(Dest, InStr(Dest, "@") + 1)
Dest = Left(Dest, InStr(Dest, ".") - 1)
 
isMailPerso = InStr(ISPPerso, ";" & Dest & ";") > 0
End Function
 
Private Function Nouveau(ByVal ShName As String, ByVal Dest As String) As Boolean
 
Nouveau = Application.CountIf(Worksheets(ShName).Range("A:A"), Dest) = 0
End Function

[meryn]

Bonjour ! merci, j'aimerai garder l'utilisation des deux zone de texte. Mais ce que vous venez de me proposer est très intéressant. y a-t-il un moyen d'adapter le code pour les doublons à mes deux zones de texte .
bonne fin de journée

[mercatog]

As tu essayé le code proposé.
Il fait la même chose pour les données des 2 feuilles

[meryn]

Bonjour ! excuse moi si j'ai mis du temps à te répondre, je viens de l'essayer.
il y'a certain point qui fonctionne notamment.
- reconnaissance des adresses mails personnelles et des adresses mails
professionnelles.
- quand je clic sur la commande d'enregistrement il me dit que
l'enregistrement de l'adresse à été effectuer avec succès en regardant
sur la feuille je vois aucune adresse nouvelle entrée.


ces point ci ne fonctionne pas:
- l'ajout sur la feuille des adresses mails en actionnant le bouton spécifié.
- doublon ( quand j'ajoute les mails identique il ya aucun message qui me
signale le mail entrer existe déjà sur la feuille.


Bon voilà , je vous souhaite une bonne journée. merci

[mercatog]

As tu supprimé les codes TextBox1_Change et TextBox2_Change

L'enregistrement du nouveau mail se fait sur la dernière cellule vide de la colonne A en partant du bas.

Voilà, le code a été testé avec succès sur mon classeur que j'ai crée pour tester.

[meryn]

ok je me remet au travail, est il possible de m'envoyer ton classeur histoire de voir comment ça fonctionne chez toi, si possible merci.

[mercatog]

Je ne l'ai plus le classeur

Construis en un avec:
1 feuille appelée Mail Professionnel
1 feuille appelée Mail Personnel
1 userform contenant:
2 TextBox, TextBox1 et TextBox2
2 Bouton, nommés Ajout1 et Ajout2

Tu colle le code dans le module de l'userform

[meryn]

Bonsoir ! Merci, je viens de le tester. J'ai juste eu à faire une petite modification.
à ce niveau :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
NomFeuille = IIf(Perso, "Mail Personnel", "Mail Professionnel")
Tpe = IIf(Perso, "Professionnel", "Personnel")

à la place j'ai remplacé:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
NomFeuille = IIf(Perso, "Mail Personnel", "Mail Professionnel")
Tpe = IIf(Perso, "Personnel","Professionnel")

Merci Beaucoup vous venez de me sauvez la vie.

[mercatog]

Non!
Dans Tpe le message d'erreur si Perso=True, le mail est Personnel et le message en cas d'erreur devrait être: ce destinataire est professionnel. (en gras la variable Tpe)