Re : Comment éviter les doublons de lignes dans une listbox
bonsoir Papapaul,Hervé,Skoobi,Excel_lent
j'ai peut être raté un épisode,on verra bien
l'idée faire le choix de la colonne,auteur ou thème ou journal,etc...
de là faire une liste sans doublons et là choisir pour la recherche
et après le code qui suit(à adapter col,montexte)
Sub MaRecherche()
Dim Plg As Variant, Cel As Range, I As Long, L As Long, C As Byte, NbC As Byte
Dim Firstaddress As String, MonTexte As String, Col As Byte
Dim MaLigne(1 To 1, 1 To 6) As Variant
'bebere
'basé sur la colonne 5,auteur
Col = 5
MonTexte = "La Pompe" 'Wanka,papapaul,La Pompe
Application.ScreenUpdating = False
With Sheets("Feuil1")
.Range("A1").Sort Key1:=.Columns(Col), Header:=xlGuess
Set Cel = .Columns(Col).Find(MonTexte, LookIn:=xlValues, LookAt:=xlPart)
If Not Cel Is Nothing Then
Firstaddress = Cel.Address
C = Cel.Row
Do
I = I + 1 'compte
Set Cel = .Columns(Col).FindNext(Cel)
Loop While Not Cel Is Nothing And Cel.Address <> Firstaddress
End If
Plg = .Range("A" & C & ":G" & I + C - 1)
End With
For I = 1 To UBound(Plg, 1)
For C = 2 To UBound(Plg, 2) - 1
MaLigne(1, C - 1) = Plg(I, C)
Next C
MaLigne(1, 6) = I 'n° de la ligne unique
For L = I To UBound(Plg, 1)
If L <> MaLigne(1, 6) Then
For C = 1 To UBound(MaLigne, 2)
If Plg(L, C + 1) = MaLigne(1, C) Then NbC = NbC + 1 'compte
Next C
If NbC = 5 Then
Plg(L, 7) = "d": NbC = 0 'marque doublons
Else: NbC = 0
End If
End If
Next L
Next I
I = 1
With Sheets("Résultat")
.Range("A2:F" & .Range("A65536").End(xlUp).Row).ClearContents
For L = I To UBound(Plg, 1)
If Plg(L, UBound(Plg, 2)) = "" Then
I = I + 1
For C = 1 To UBound(Plg, 2) - 1
.Cells(I, C).Value = Plg(L, C)
Next C
End If
Next L
End With
Application.ScreenUpdating = True
End Sub
à bientôt
Bonjour le Forum,
