Retrouver des doublons en cliquant sur une cellule

[isa44]

Bonjour , sollicite votre aide pour créer un code VBA :
Il s'agit de mettre les fonds de cellules en rouge des doublons retrouvés dans le cadre rose lorsqu'une cellule jaune est sélectionnée.

Je joint un fichier exemple pour une meilleure compréhension.

Merci par avance pour votre aide et bonne rentrée .....

 

[pierrejean]

Re : Retrouver des doublons en cliquant sur une cellule

Bonjour Isa

Vois si cela te convient

 

[isa44]

Re : Retrouver des doublons en cliquant sur une cellule

Super ,
En fait sur le vrai fichier dans les tableaux les cellules ont des fonds en couleur.
Je voudrais revenir aux fonds d'origine quand l'on sélectionne une autre cellule jaune.

 

[pierrejean]

Re : Retrouver des doublons en cliquant sur une cellule

Re

Un tantinet capillotracté
A tester

 

[isa44]

Re : Retrouver des doublons en cliquant sur une cellule

Bonjour , oui c'est " un tantinet capillotracté " !!!
J'essaierais de comprendre le code et de l'adapter à mon fichier la semaine prochaine.

Merci

 

[isa44]

Re : Retrouver des doublons en cliquant sur une cellule

Bonjour , je me remet sur mon projet.

Je n'arrive pas à modifier le nombre de lignes des tableaux : il peuvent avoir indifféremment 2 ,3 ,4 ou 5 lignes.

Où faut il modifier le code pour pouvoir traiter les différents tableaux ?

Public tablo
Public existtablo
Private Sub Worksheet_SelectionChange(ByVal Target As Range)


If existtablo Then
  For n = LBound(tablo, 2) To UBound(tablo, 2) - 1
   Range(tablo(0, n)) = tablo(2, n)
   Range(tablo(0, n)).Interior.ColorIndex = tablo(1, n)
  Next
 End If


If Target.Interior.ColorIndex = 6 Then
 ReDim tablo(2, 0)
 x = Target.Row
 For Each cel In Range(Cells(x, 2), Cells(x + 2, 20))
  tablo(0, UBound(tablo, 2)) = cel.Address
  tablo(1, UBound(tablo, 2)) = cel.Interior.ColorIndex
  tablo(2, UBound(tablo, 2)) = cel.Value
'
'tablo(3, UBound(tablo, 2)) = cel.Value
  ReDim Preserve tablo(2, UBound(tablo, 2) + 1)
 Next



 existtablo = True
 Range(Cells(x, 2), Cells(x + 1, 20)).Interior.ColorIndex = xlNone
 For Each cel In Range(Cells(x, 2), Cells(x + 1, 20))
  For Each cell In Range("ROSE")
  
 
    If cel.Value = cell.Value Then
      cel.Interior.ColorIndex = 3
    End If
    
     '''''''''''''''''''''''''
  If cel.Value = "" Then
      cel.Interior.ColorIndex = xlNone
    End If
  
  Next
 Next
 Set dertarget = Target
End If
End Sub

 

[pierrejean]

Re : Retrouver des doublons en cliquant sur une cellule

Re
Teste cette version qui prend en compte le nombre de lignes fusionnées de la colonne A