Re : Liste deroulante selon conditions multiples
Bon j'ai pas mal avancé mais je bute sur plusieurs elements.
Voici mon code avec en rouge les éléments bloquants:
Dim flag As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
'pour eviter de reboucler la macro a chaque changement
If flag Then Exit Sub
flag = True
'si la macro est declenchée par la plage de cellule 'session'
nomListe = "Liste_" & Target.Value
'test si la liste existe
'Effacement de la LISTE
Application.ScreenUpdating = False
Application.Goto reference:=nomListe
Selection.ClearContents
Application.ScreenUpdating = True
'initialisation du numero de colonne qui contiendra ma futur liste
numColListe = 1
maCell = Sheets("feuil1").Cells(1, 1)
'boucle jusqu'a ce que je trouve la bonne valeur
Do While maCell <> ""
maCell = Sheets("feuil1").Cells(1, numColListe)
If maCell = Target.Value Then
Exit Do
End If
numColListe = numColListe + 1
Loop
maLigne = 2
'Recherche de la valeur de 4 a la derniere ligne de la colonne A
For n = 4 To Sheets("Agences-utilisateurs").Range("A65536").End(xlUp).Row
'recherche dans la ligne n le contenu de BY25
Set c = Sheets("Agences-utilisateurs").Rows(n).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
'si trouvé
If Not c Is Nothing Then
'creation de la liste dans la feuille feuil1
Sheets("feuil1").Cells(maLigne, numColListe) = Sheets("Agences-utilisateurs").Cells(n, 1)
maLigne = maLigne + 1
End If
Next n
'Suppression de la LISTE avant redefinition
ActiveWorkbook.Names(nomListe).Delete
'redefinition de la LISTE
ligneFin = maLigne - 1
plageSelection = "=feuil1!" & Sheets("feuil1").Cells(2, numColListe).Address() & ":" & Sheets("feuil1").Cells(ligneFin, numColListe).Address()
ActiveWorkbook.Names.Add Name:=nomListe, RefersTo:=plageSelection
'affectation de la liste aux cellules concernées
For n = 34 To 34 + 8
With Range("by" & n).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=" & nomListe
End With
Next n
'End If
'si c'est une valeur d'option qui est modifiée
'If Target.Column = 4 And Target.Row > 6 Then
'recherche de la celule de la colonne A qui contient l'option
' Set d = Sheets("Options REM").Columns(1).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
'avec decalage par rapport a l'option de 4 puis 2 colonnes inscription du prix et de la remarque
' Target.Offset(0, 4) = Sheets("Options REM").Cells(d.Row, 4)
' Target.Offset(0, 2) = Sheets("Options REM").Cells(d.Row, 2)
End If
'on libere le drapeau qui evite le rebouclage de la macro
flag = False
End Sub
D'avance merci pour votre aide