XL 2016 Alerte doublon sur plusieurs feuilles

Scorpio

XLDnaute Impliqué
Bonjour à tous,
Dans mon classeur, en colonne "A", j'ai une série de chiffre, sur 5 feuilles.
Le code se trouve en feuille "A"
Si vous saisissez 1 chiffre doublon dans la colonne "A" de la feuil1, le message vas interdir de saisir le chiffre doublon.
MAIS, comment faire pour coordonner le code de façon a ce que si, vous saisissez un chiffre dans la feuil1, ou 2, ou 3, ou 4, ou 5,
Le code vas vous informer que vous avez un doublon dans 1 des 5 feuilles.
C'est un casse tête hein…
Je demande à un des membres, s'il vous plaît, car je ne suis pas un AS du code, de bien vouloir me donner un coup de pouce.
Merci à vous, et A+++++
 

Pièces jointes

  • AlerteCodeUniquePlusieursFeuille.xlsm
    24.5 KB · Affichages: 14

Staple1600

XLDnaute Barbatruc
Re

Bon le temps que mon petit frichti du samedi midi mitonne, j'ai francisé un peu la macro citée dans mon précédent message (et je l'ai testée, elle fonctionne)
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Définition des variables.
Dim ws As Worksheet, EvalRange As Range
Set EvalRange = Range("A1:B20") 'ici indiquer la plage de cellules à surveiller
    'If the cell where value was entered is not in the defined range, if the value pasted is larger than a single cell,
    'or if no value was entered in the cell, then exit the macro.
    'j'ai commencé la traduction, je laisse poursuivre ;-)
    'Si la cellule active (Target) n'appartient pas à EvalRAnge et si celle-ci n'est pas une cellule unique ou si la saisie
    'est vide alors on sort de la procédure
    If Intersect(Target, EvalRange) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
    'If the value entered already exists in the defined range on the current worksheet, throw an
    'error message and undo the entry.
    If WorksheetFunction.CountIf(EvalRange, Target.Value) > 1 Then
        MsgBox Target.Value & " existe déjà sur cete feuille!", vbCritical, "Le Detecteur de Doublons, amateur de houblon"
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
    End If
    'Vérification sur les autres feuilles du classeur.
    For Each ws In Worksheets
        With ws
            If .Name <> Target.Parent.Name Then
                'If the value entered already exists in the defined range on the current worksheet, throw an
                'error message and undo the entry.
                If WorksheetFunction.CountIf(Sheets(.Name).Range("A1:B20"), Target.Value) > 0 Then
                    MsgBox Target.Value & " existed déja sur la feuille: " & .Name & ".", _
                    16, "Aucun doublon autorisé dans la plage de cellules: " & EvalRange.Address(0, 0) & "."
                    Application.EnableEvents = False
                    Application.Undo
                    Application.EnableEvents = True
                    Exit For
                End If
            End If
        End With
    Next ws
End Sub
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Scorpio et pour saluer @Staple1600 :

Essayez le code suivant à mettre dans le module de ThisWorkbook :
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

'liste des feuilles où chercher les doublons
Const LesFeuilles = "feuil1,feuil2,feuil3,feuil4,feuil5"

Dim NomFeuil, res, n&, i&, s$, doublon As Boolean, nom$

  If Target.Count > 1 Then Exit Sub
  If Target.Row = 1 Then Exit Sub
  If Target = "" Then Exit Sub
  On Error Resume Next
  For Each NomFeuil In Split(LesFeuilles, ",")
    With Worksheets(Trim(NomFeuil))
      If LCase(NomFeuil) <> LCase(Target.Parent.Name) Then
        Set res = .Columns(1).Find(what:=Target.Value, _
                       LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
        If Not res Is Nothing Then
          nom = .Name
          doublon = True: Exit For
        End If
      Else
        If Application.CountIf(.Columns(1), Target.Value) > 1 Then
          nom = .Name
          doublon = True: Exit For
        End If
      End If
    End With
  Next NomFeuil
  If doublon Then
    s = "La valeur saisie < " & Target.Value & " > se retrouve aussi "
    s = s & vbLf & vbLf & "sur la feuille : " & nom
    MsgBox s, vbCritical
    Target.ClearContents
  End If
End Sub

nota: il faut bien sûr partir d'une situation saine, c'est à dire sans doublon sur les feuilles considérées.
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour le fil, Scorpio, mapomme ;)

Bonjour à vous,
Y aurais-t-il un membre, pour me dépanner sur ce soucis sur ma question du #1
Merci beaucoup A++++
[mapomme]
Merci de m'avoir rendu ma qualité de membre d'XLD en me saluant contrairement à Scorpio...
Sans doute verse-t-il dans le masochisme (surtout le week-end) ;)
Car sinon comment comprendre qu'ayant posé sa question#1, samedi à 12h16, il zappe volontairement mes deux posts dans lesquels il y avait dès 12h22 puis 12h56 une solution possible à sa question...

Si je compte bien mapomme et moi dans ce fil, ça fait deux donc pile poil ce cas de figure
[extrait de la charte du forum]
6 - MERCI est la seule récompense des contributeurs. Donc ne pas oublier de les remercier une fois la réponse donnée.

PS: Heureusement, les presque 70 affichages de ce fil m'incline à penser que d'autres que Scorpio s’intéresseront à ma proposition (sans oublier celle de mapomme) :)
 

Discussions similaires

Réponses
22
Affichages
691
Réponses
10
Affichages
350

Statistiques des forums

Discussions
311 735
Messages
2 082 024
Membres
101 873
dernier inscrit
excellllll