XL 2010 Détection des doublons sur plusieurs pages en VBA

Maxence.P

XLDnaute Nouveau
Bonjour,

Je suis nouveau sur ce forum et je n'ai pas eu le temps de regarder toutes les discussions, je m'excuse donc si cette question a déjà été posée.

Pour mon travail, je modifie actuellement un fichier sur lequel se trouvent plusieurs feuilles comprenant chacune un tableau avec des noms/prénoms et autres informations. Ce fichier est un regroupement de tous les inscrits aux différents restaurants de mon entreprise (Sur chaque feuille il n'y a les inscrits que d'une seule cantine). Cependant, chaque salarié n'a la droit d'être inscrit qu'à un seul restaurant. L'objectif est donc de voir si un salarié s'est inscrit à deux restaurants.
Afin d'optimiser l'utilisation de ce fichier, je souhaiterais créer une macro qui :
En premier, ouvrirait une InputBox qui me permettrait de saisir un nom et un prénom

Ensuite, la macro cherchera le nom et prénom dans le tableau de chaque feuille afin de voir s'il existe plusieurs fois le même nom et prénom dans les différentes feuilles.
(Le nom et le prénom sont uniques sur chaque feuille mais peuvent exister sur d'autre feuille)(Plus clairement une détection des doublons mais sur plusieurs feuilles).

Si l'exécution de la macro détecte des doublons, elle indiquera un message indiquant qu'"il y a des doublons" et si possible, combien.

Si l'exécution de la macro ne détecte pas de doublon, alors elle indiquera que "le nom et prénom n'existe qu'une seule fois".

J'espère avoir été le plus clair possible et je vous remercie sincèrement par avance pour tous ceux qui auraient une aide à m'apporter.
Cordialement,
Maxence.P
 

Robert

XLDnaute Barbatruc
Repose en paix
Bonsoir Maxence, bonsoir le forum,

Essaie comme ça :

VB:
Option Explicit

Sub Macro1()
Dim N As Variant 'déclare la variable N (Nom)
Dim P As Variant 'déclare la variable P (Prénom)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim NF As Integer 'déclare la variable NF (Nombre de Fois)
Dim MSG1 As String 'déclare la variable MGS1 (MeSsaGe 1)
Dim MSG2 As String 'déclare la variable MSG2 (MeSsaGe 2)

N = Application.InputBox("Tapez le nom.", "NOM", Type:=2) 'définit la boîte d'entrée N (Nom)
If N = False Or N = "" Then Exit Sub 'si bouton [Annuler] ou non renseignée, sort de la procédure
P = Application.InputBox("Tapez le prénom.", "PRÉNOM", Type:=2) 'définit la boîte d'entrée P (Prénom)
If P = False Or P = "" Then Exit Sub 'si bouton [Annuler] ou non renseignée, sort de la procédure
For Each O In Worksheets 'boucle 1 : sur tous les onglets O du classeur
    DL = O.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet O
    TV = O.Range("B1:C" & DL) 'définit le tableau des valeurs TV
    For I = 1 To DL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
        'condition : si la donnée en colonne 1 de TV est égale au nom N et la donnée en colonne 2 de TV est égale au prénom P
        '(Trim supprime d'éventuels espaces avant et après tandis que UCase transforme tout en majuscule et accepte toutes les casses)
        If UCase(Trim(TV(I, 1))) = UCase(Trim(N)) And UCase(Trim(TV(I, 2))) = UCase(Trim(P)) Then
            NF = NF + 1 'incrément ele nombre de fois NF
            'définit le message MSG2 en proposant le nom de l'onglet et le numéro de ligne
            MSG2 = MSG2 & Chr(13) & "Onglet " & O.Name & ", ligne : " & I
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
Next O 'prochain onglet de la boucle 1
If NF = 0 Then MsgBox N & " " & P & " n'existe pas !": Exit Sub 'message si NF est égale à 0,sort de la procédure
If NF = 1 Then 'condition : si NF est égale à 1
    MSG1 = N & " " & P & " n'existe qu'une seule fois." 'définit le message MSG1
    MsgBox MSG1 'affiche le message MSG1
Else 'sinon
    MSG1 = N & " " & P & " se trouvent " & NF & " fois." & Chr(13) 'définit le message MSG1
    MsgBox MSG1 & MSG2 'affiche le mesage MSG1 suivi du message MSG2
End If 'fin de la condition
End Sub
 

Maxence.P

XLDnaute Nouveau
Bonjour Robert, bonjour le forum,

Je tiens à te remercier grandement pour ton investissement, il m'a grandement aidé. La formule fonctionne parfaitement même si j'avoue ne pas la comprendre totalement. L'essentiel c'est qu'elle fonctionne !

A nouveau merci,
Cordialement,
Maxence.P
 

Discussions similaires

Statistiques des forums

Discussions
312 104
Messages
2 085 349
Membres
102 868
dernier inscrit
JJV