récupérer les doublons

[magalie]

bonjour à toutes et à tous,
j'ai un listbox qui me récupère uniquement les doublons mais c'est sur deux plages fixes.
je souhaite récupérer les doublons dans ma listbox en selectionnant deux lignes contigues et sur 5 colonnes
la comparaison se fait sur les deux lignes pas les colonnes.
en vous remerciant tous
bonne glisse mais attention à la chute

 

[job75]

Re : récupérer les doublons

Bonjour magalie,

2 objets Dictionary pour trouver les doublons de 2 malheureuses lignes c'est le marteau pilon...

Dans le code de Feuil1 (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim zone As Range, plage As Range, cel As Range
Set zone = [B:F] 'à adapter éventuellement
Set plage = Intersect(Target, zone)
If Not plage Is Nothing Then
  If plage.Rows.Count = 2 And plage.Columns.Count = zone.Columns.Count Then
    For Each cel In plage.Rows(2).Cells
      If Application.CountIf(plage.Rows(1), cel) Then UserForm1.ListBox1.AddItem cel
    Next
    UserForm1.Show
  End If
End If
End Sub

Application.CountIf (NB.SI) fait très bien l'affaire.

Fichier joint.

A+

 

[magalie]

Re : récupérer les doublons

bonjour job
je sais c'est de l'artillerie lourde mais comme je subodore que l'on va me demander plus,j'anticipe.
encore merci pour le fichier

 

[youky(BJ)]

Re : récupérer les doublons

Bonjou Mag , bonjour Job,
J'ai fait comme j'ai pigé et avec possibilité de selectionner les lignes
Bruno

 

[magalie]

Re : récupérer les doublons

merci bruno ça marche aussi

 

[job75]

Re : récupérer les doublons

Re, salut Bruno,

je reviens sur ma solution.

Si sur une même ligne il y a des doublons, on peut les retrouver dans la ListBox.

Pour les éliminer il faut utiliser un objet Dictionary :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim zone As Range, plage As Range, d As Object, c As Range
Set zone = [B:F] 'à adapter éventuellement
Set plage = Intersect(Target, zone)
If Not plage Is Nothing Then
  If plage.Rows.Count = 2 And plage.Columns.Count = zone.Columns.Count Then
    Set d = CreateObject("Scripting.Dictionary")
    For Each c In plage.Rows(2).Cells
      If Application.CountIf(plage.Rows(1), c) Then d(c.Value) = c.Value
    Next
    UserForm1.ListBox1.List = d.keys
    UserForm1.Show
  End If
End If
End Sub

Fichier (2).

A+