Bonjour à tous,
Afin de déterminer s'il y a des doublons dans une liste de taille variable, j'ai essayé d'adapter un dico sur une plage de cellules à une liste.
Mais le code me donne toujours la réponse qu'il y a des doublons sur une liste qui n'en a pas
aprés vérification, çà bug parceque j'ai mis dercol pour evaluer la dernière colonne avec .row
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17 Private Sub salars_Click() Dim i%, ws1 As Worksheet, drn1% Application.ScreenUpdating = False Set ws1 = Sheets("taches") drn1 = ws1.Range("G" & Rows.Count).End(xlUp).Row 'remplissage liste des salaries For i = 2 To drn1 If CSng(Me.numT.Value) = CSng(ws1.Range("E" & i).Value) Then drcol = ws1.Cells(i, 30).End(xlToLeft).Row For j = 11 To drcol Step 2 Me.LstSals.AddItem Me.LstSals.List(Me.LstSals.ListCount - 1, 0) = ws1.Cells(i, j).Value 'salariés Next j End If Next i Application.ScreenUpdating = True End Sub
Voilà le fichier forum.xlsm
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10 Set dico = CreateObject("scripting.dictionary") dico.CompareMode = TextCompare For i = 0 To Me.LstSals.ListCount - 1 If LstSals.ListCount <> 0 And Not dico.exists(Me.LstSals.List(i)) Then dico.Add Me.LstSals.List(i), "" ElseIf LstSals.ListCount <> 0 And dico.exists(Me.LstSals.List(i)) Then cpt = 1 End If Next i If cpt > 0 Then MsgBox "Il ne peut y avoir 2 fois le même salarié dans la liste.": GoTo fin
La macro concernée, Private Sub modif_Click(), se trouve en UF taches.
Pour la tester, un double clic sur une ligne de l'onglet taches, et un clic sur le bouton salaries, puis sur modifier.
Merci d'avance.![]()
Partager