Re alors 3 choses
initilise la liste Box 1 sans doublons a présent en utilisant une colonne intermédiare ZZ
Sub init_listing_recherche()
Ws.Range("A:A").Copy Ws.[ZZ1]
Ws.Range("ZZ:ZZ").RemoveDuplicates Columns:=Array(1), Header:=xlYes
If Ws.Range("ZZ65536").End(xlUp).Row = 2 Then
Me.Box1.AddItem Ws.[ZZ2]
Else
Me.Box1.List = Range("ZZ2:ZZ" & Ws.Range("ZZ65536").End(xlUp).Row).Value
End If
Ws.[ZZ:ZZ].Delete
End Sub
lors d'un changement sur le box1
Private Sub Box1_Change()
Dim j As Long
Dim i As Byte
'init toutes les autres box avec rien
For i = 2 To 31
Controls("Box" & i) = ""
Next
If Me.Box1.ListIndex = -1 Then Exit Sub
'efface la liste des item dans la liste des prenoms (Ajout de maintenant )
Do While Box2.ListCount > 0
Box2.RemoveItem (0)
Loop
'creation de la liste deroulante des prenoms
With Me.Box2
For j = Me.Box1.ListIndex + 2 To NbLignes
If Ws.Range("A" & j) = Me.Box1 Then
.AddItem Ws.Range("B" & j)
.List(.ListCount - 1, 1) = j
End If
Next j
End With
End Sub
lors sur changement d'un prenom
Private Sub Box2_Change()
Dim Ligne As Long
Dim i As Integer
'Nettoyage 'Lance le programme Nettoyage
If Me.Box2.ListIndex = -1 Then Exit Sub
'recupere la ligne ou se trouve la personne ligne tu nom + un declage de ligne de prenom eventuel + 2 car la BDD commence a la ligne 2
Ligne = Me.Box1.ListIndex + Me.Box2.ListIndex + 2
'remplissage des autres box
For i = 3 To 31
Me.Controls("box" & i) = Ws.Cells(Ligne, i)
Next i
End Sub
derniere chose que j'ai été obliger de changer dans ton code :
dans pricate box6 change :
If Box6 = "" Then Exit Sub
If CLng(Box6) * 1 > 1000 Then
Attention ne marchera que si la ta base de donnée est triée par ordre alphabétique au niveau des noms puisque suppression des les noms en doublons....
Edit nouvelle version du fichier
https://www.cjoint.com/c/EIBtGXZzyQl
fred