récupérer les doublons

magalie

XLDnaute Occasionnel
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
 

Pièces jointes

  • ESSAI1.xls
    38.5 KB · Affichages: 43
  • ESSAI1.xls
    38.5 KB · Affichages: 47
  • ESSAI1.xls
    38.5 KB · Affichages: 51

job75

XLDnaute Barbatruc
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) :

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+
 

Pièces jointes

  • ESSAI(1).xls
    47 KB · Affichages: 49
  • ESSAI(1).xls
    47 KB · Affichages: 50
  • ESSAI(1).xls
    47 KB · Affichages: 54

youky(BJ)

XLDnaute Barbatruc
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
 

Pièces jointes

  • ESSAI2.xls
    41 KB · Affichages: 43
  • ESSAI2.xls
    41 KB · Affichages: 41
  • ESSAI2.xls
    41 KB · Affichages: 39

job75

XLDnaute Barbatruc
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 :

Code:
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+
 

Pièces jointes

  • ESSAI(2).xls
    48.5 KB · Affichages: 50
  • ESSAI(2).xls
    48.5 KB · Affichages: 59
  • ESSAI(2).xls
    48.5 KB · Affichages: 56

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG