avertir quand une valeur existe déjà dans 1 plage

[daniel]

Bonsoir le forum !

Voilà mon souci...Dans une colonne, j'ai plusieurs noms. Je voudrais qu'un message m'avertisse si je saisis de nouveau ce même nom. J'ai écrit la procédure suivante :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim test As Range
Dim plage As Range

Set plage = [A1:A50]
For Each test In plage
If ActiveCell.Value = test.Value Then
MsgBox 'valeur existante'
Exit Sub
End If
Next test
End Sub

Le problème est que j'ai le message 'valeur existante' à chaque fois ! Quelle est mon erreur ?

Merci et bonne soirée à toutes et tous

Daniel

 

[Dan]

Bonsoir,

Je peux te proposer une solution sans macro.

Fais ceci :

- Sélectionne dans la colonne toutes les cellules qui ne doivent pas avoir de doublons
- Va dans menu / outils / liste de validation / Personnalisé
- Mets la formule NB.SI ($A:$A;a1)=1 dans liste de validation / options / personnalisé.
Avec
- A:A : colonne devant être controlée
- A1 : 1ère cellule sélectionnée lorsque tu tapes ta formule
- Eventuellement cocher la case 'appliquer ces modifications aux cellules identiques


Un fil intéressant à ce sujet :
Lien supprimé

 

[Gérard DEZAMIS]

Bonsoir Dan (1+ iel)

Il y a aussi une Mise en forme conditionnelle qui serait pratique avec la formule
=nb.si(Plage;1°cellule de la plage)>1 et un format très coloré ....

@+ GD

 

[Dugenou]

Bonsoir Gérard, bonsoir les Dan

Je suis loin d'être un spécialiste en macro mais j'essaye de comprendre les codes quand j'en vois.
Dans le cas de la macro de Daniel, je demande si dans la procédure 'for each test in plage' -> 'next test' : il y a un moment ou la cellule testée est la cellule que tu viens de saisir et donc tu as toujours un moment où la valeur est déjà existante. Il faudrait peut être faire un compteur après le test et déclencher la msgbox que quand le compteur est supérieur à 1.

Pour la méthode Dan, rien à dire : j'ai testé

Pour la méthode Gérard,rien à dire, j'aurais fait pareil !

Bye

PS : Dan : je crois que je vais passer ZOPtesteur !

Message édité par: Dugenou, à: 07/04/2005 22:55

 

[Dan]

OK, Jean yves.

Dans ma formule, le chiffre 1 n'autorise aucun doublon dans la colonne.
Bien entendu, il faut que cette formule soit dans chaque cellule de la colonne A:A et ce, avant que l'on y encode une donnée.

Si le chiffre passe passe à deux, il autorisera 2 doublons maximum.

 

[Gérard DEZAMIS]

Salut Dugenou Dan et Daniel

ZOPtesteur ? Gros béta ! Testeur !

Pour le ZOP c'est renversant fais une POZ !

Rien de ce code n'est de moi mais j'épluche le VBA pour essayer

MOI ZOSSI oui oui oui Mister Dugenou
d'y comprendre qq chose

on est dans la même galère
Ramons, Ramez !

alors je vous confie mes archives ....




@+ GD
[file name=Signaler les doublons_20050407231019.zip size=9119]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Signaler les doublons_20050407231019.zip[/file]

 

[Hervé]

Bonsoir tout le monde

j'arrive après la bagarre, c'était juste pour préciser à daniel que son souci venait de la plage testé.

En effet en testant A1:A50 alors que tu te trouves en ligne 14 par exemple tu testes aussi de A15 à A5O et donc des cellules vides, et pour excel rien ne ressemble plus à une cellule vide, qu'une autre cellule vide.

Il faut donc limiter la recherche de A1 à l'avant dernière ligne utilisé et pas à la dernière sinon, tu testes A14 avec A14.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim test As Range
Dim plage As Range

Set plage = Range('A1:A' & Target.Row - 1)
For Each test In plage
If Target.Text = test.Text Then
MsgBox 'valeur existante'
Target.Select
Exit Sub
End If
Next test

End Sub

De plus dans ce type de macro évenementielle il vaut mieux utilisé target que activecell.

Enfin ce code peut être améliorer en testant la colonne de travail, ou en testant minuscule/majuscule.

Voili voilou

en m'excusant d'avoir été long, mais au KAZOU ca peut rendre service.

Salut

 

[Philippe]

Bonsoir à tous,

en fait le problème me semble bien plus complexe:

dans ton code Daniel, tu testes toute la plage, y compris ce que tu viens de saisir, alors forcemment, VBA trouve un 'pseudo'doublon
il faudrait donc exclure de la recherche la dernière cellule saisie et c'est là que ça se complique car si tu valides autrement que par ENTER (en cliquant ailleurs par exemple) il faut mémoriser le dernière cellule saisie avant le chgt (et là c'est pas simple...)
Je vais cogiter là dessus...

 

[Philippe]

Ca y est, j'y suis,

le code suivant trouve le ou les doublons, t'avertis et te localise les doublons en colorant la cellule en rouge

Private Sub Worksheet_Change(ByVal Target As Range)
Dim test As Range
Dim plage As Range
Set plage = [A1:A50]
For Each test In plage
test.Interior.ColorIndex = 0
coul = 3
If Target.Value = test.Value And test.Value <> '' Then
If test.Row = Target.Row Then coul = 0
test.Interior.ColorIndex = coul
x = x + 1
If x > 1 Then
test.Interior.ColorIndex = coul
MsgBox 'valeur existante'
GoTo suit

End If
End If
suit:
Next test

End Sub

 

[Bernard_XLD]

Bonjour Daniel, Dan, Gérard, Dugenou, Hervé, Philippe, le forum

Je prends le train en marche et propose une petite variation sur le thème.

Cordialement, A+

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = '' Or Target.Row > 50 Then Exit Sub ' on ne teste que si target >'' et appartient à la plage testée
Dim Cel_Test As Range
For Each Cel_Test In ActiveSheet.Range('A1').Offset(0, Target.Column - 1).Range('A1:A50').SpecialCells(xlCellTypeConstants, 23) ' teste chaque cellule non vide de la ligne 1 à 50 de la colonne de la cellule en cours
If Not (Cel_Test.Address = Target.Address) And Cel_Test.Value = Target.Value Then ' exécute si la cellule testée n'a pas l'adresse de target mais a la même valeur
MsgBox 'La valeur entrée en ' & Target.Address(RowAbsolute:=False, Columnabsolute:=False) & ' existe déja en ' & Cel_Test.Address(RowAbsolute:=False, Columnabsolute:=False), vbInformation
'Target.Value = '' 'à valider si on désire interdire les doublons
Target.Select 'sélectionne target si la condition est vérifiée
End If
Next Cel_Test
End Sub

 

[Bernard_XLD]

Re bonjour

une petite amélioration, si les doublons sont autorisés il n'y a qu'un seul message pour l'ensemble des valeurs égales.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = '' Or Target.Row > 50 Then Exit Sub ' on ne teste que si target >\\'\\' et appartient à la plage testée
Dim Cel_Test As Range
Dim Msg_String As String
For Each Cel_Test In ActiveSheet.Range('A1').Offset(0, Target.Column - 1).Range('A1:A50').SpecialCells(xlCellTypeConstants, 23) ' teste chaque cellule non vide de la ligne 1 à 50 de la colonne de la cellule en cours
If Not (Cel_Test.Address = Target.Address) And Cel_Test.Value = Target.Value Then ' exécute si la cellule testée n'a pas l'adresse de target mais a la même valeur
Msg_String = Msg_String & ' ' & Cel_Test.Address(RowAbsolute:=False, Columnabsolute:=False)
End If
Next Cel_Test
If Len(Msg_String) > 0 Then 'exécute si des doublons ont été détectés
MsgBox 'La valeur ' & Target.Value & ' entrée en ' & Target.Address(RowAbsolute:=False, Columnabsolute:=False) & ' existe déja en' & Msg_String, vbInformation
'Target.Value = '' 'à valider si on désire interdire les doublons
Target.Select
End If
End Sub


[file name=Classeur2_20050408090621.zip size=8398]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Classeur2_20050408090621.zip[/file]

 

[daniel]

Bonjour le forum !

Que de réponses....un grand merci à vous tous, vraiment. je vais me mettre à tester toutes ces méthodes, cela devrait me faire progresser un petit peu dans ma modeste connaissance de VBA.

Ce forum est vraiment une mine !!

Bonne journée à tous et encore merci

Daniel