Signalisé Doublons par code vba excel

Version imprimable

10/04/2012, 23h08
meryn

Signalisé Doublons par code vba excel

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.

Citation:

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:

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

10/04/2012, 23h44
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".
10/04/2012, 23h59
SfJ5Rpw8

Et ce message d'erreur , qu'attends tu pour le lire t le copier ici ?
11/04/2012, 00h08
meryn

Erreur d'exécution '1004':

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

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:

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

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:

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:

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:

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

Code:

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

Code:

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

Code:

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

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:

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

12/04/2012, 17h14
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
12/04/2012, 17h17
mercatog

As tu essayé le code proposé.
Il fait la même chose pour les données des 2 feuilles
13/04/2012, 12h41
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
13/04/2012, 13h32
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.
13/04/2012, 13h39
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.
13/04/2012, 13h43
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

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

1 2 NomFeuille = IIf(Perso, "Mail Personnel", "Mail Professionnel") Tpe = IIf(Perso, "Professionnel", "Personnel")
à la place j'ai remplacé:
Code:

1 2 3 NomFeuille = IIf(Perso, "Mail Personnel", "Mail Professionnel") Tpe = IIf(Perso, "Personnel","Professionnel")
Merci Beaucoup vous venez de me sauvez la vie.:ccool:

13/04/2012, 23h59
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)