Bonjour Marion, Frank et Eric
J'arrive un peu après la bataille, mais voici en pièce jointe un code assez paramétrable, permettant de répondre à la question....
Il est composé de deux parties
- Un générateur de jeu d'essais (Facultatif)
- Un détecteur de singletons (Problème posé)
=====================================================
Private Sub CommandButton1_Click()
'Références des zones utilisées. Peuvent être adaptées sous réserve de deux conditions
'Les zones A/B/C ne peuvent s'étaler que sur une colonne
'La zone C doit avoir le même nombre de lignes que la Zone A
Set RngColA = Range("A6:A400") 'Zone A noms à rechercher
Set RngColB = Range("B6:B400") 'Zone B noms de référence
Set RngColC = Range("C6:C400") 'Zone C noms recherchés ne correspondant pas à un nom de référence
'Désactivation de l'affichage
Application.ScreenUpdating = False
'Copie cellules Zone A dans cellules Zone C
RngColA.Copy Destination:=RngColC
'Effacement des cellules Zone A ayant une cellule à contenu équivalent dans zone B
For Each Celc In RngColC
For Each CelB In RngColB
If CelB = "" Then Exit For
If Celc = CelB Then
Celc.Value = ""
Exit For
End If
Next CelB
Next Celc
'Tri des résultats dans Zone C
RngColC.Sort Key1:=RngColC.Cells(1), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Effacement des doublons dans Zone C
For i = 2 To RngColC.Rows.Count
If RngColC.Cells(i) = RngColC.Cells(i - 1) Then RngColC.Cells(i).Value = ""
Next i
'Tri des résultats dans zone C pour éliminer les cellules vides intermédiaires
RngColC.Sort Key1:=RngColC.Cells(1), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Réactivation de l'affichage
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
'Les zones A/B/C sont redéfinies ici pour éviter la dispersion du code
Set RngColA = Range("A6:A400") 'Zone A noms à rechercher
Set RngColB = Range("B6:B400") 'Zone B noms de référence
Set RngColC = Range("C6:C400") 'Zone C noms recherchés ne correspondant pas à un nom de référence
Set RngColI = Union(RngColA, RngColB) 'Zone à initialiser
'Désactivation de l'affichage
Application.ScreenUpdating = False
'Génération aléatoire d'un nombre de 0 à 1000
For Each Cel In RngColI
Cel.Value = Int(Rnd * 1000)
Next Cel
'Effacement du contenu de la zone C
RngColC.ClearContents
'Réactivation de l'affichage
Application.ScreenUpdating = True
End Sub
=====================================================
Bon week-end à tous.
Omicron.
