Liste deroule selon conditions multiples

[Rhochat]

Liste deroulante selon conditions multiples

Bonjour,
après plusieurs recherches, je ne trouve pas mon bonheur. J'ai fait un peu de dev mais pas en VBA. Je suis debutant dans Excel et VBA...
Voici mon pb (qui n'en ai pas un):
J'ai un fichier Excel avec plusieur onglet.
Sur le premier j'ai une liste de personne avec en face de leur nom jusqu'a 5 roles differents.
Sur le deuxieme onglet, j'ai un planning avec des types de formations dispancées (correspondant au roles).

En gros je veux avoir une liste deroule des gens que je peux ajouter a telle ou telle formation selon mon critère "type de formation".
La ou je prèche vraiment, j'aimerais rendre ca dynamique.
A savoir si je rajoute un gas dans la liste ou si je rajoute une formation les listes se recalculent.

J'espere avoir été clair.

 

[Rhochat]

Re : Liste deroulante selon conditions multiples

En analytique je vois exactement quoi faire:
1- créer mon nombre de liste (1 liste = un role)
2- parcourir ma colonne de nom et l'ajouter à telles ou telles listes en fonction de ses fonctions.
biensur une meme personne peut s'ajouter à 5 listes differentes
3- faire un test sur le contenu de telle ou telle cellule de mon panning et renvoyer le nom de la liste correspondante.
4- créer en Excel la liste deroulante.

Help me please

 

[Rhochat]

Re : Liste deroule selon conditions multiples

Voici mon fichier de base

 

[Rhochat]

Re : Liste deroule selon conditions multiples

Personne pour m'aider?

 

[bcharef]

Re : Liste deroule selon conditions multiples

Bonjour Rhochat,
Bonjour à toutes et à tous.

Bienvenue sur XLD.

Est-il possible de nous joindre votre fichier sous excel 2003 ?

A vous lire et bon courage.

Cordialement.

BCharef

 

[Rhochat]

Re : Liste deroulante selon conditions multiples

Voila.
J'essai de broder à partir d'un code fourni ici mais en vain...

 

[Rhochat]

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

 

[Rhochat]

Re : Liste deroule selon conditions multiples

Ce code passe mais ne fait pas apparaitre le nom de la liste dans ma feuil1 ???

plageSelection = Sheets("feuil1").Range(Cells(2, numColListe).Address(), Cells(ligneFin, numColListe).Address())
ActiveWorkbook.Names.Add Name:=nomListe, RefersTo:=plageSelection

Quelqu'un aurait il une idée?

Pb résolu par ce code:
ligneFin = maLigne - 1
MsgBox Sheets("feuil1").Cells(2, numColListe).Address() & " " & Sheets("feuil1").Cells(ligneFin, numColListe).Address()
plageSelection = "=feuil1!" & Sheets("feuil1").Cells(2, numColListe).Address() & ":" & Sheets("feuil1").Cells(ligneFin, numColListe).Address()
ActiveWorkbook.Names.Add Name:=nomListe, RefersTo:=plageSelection

 

[Rhochat]

Re : Liste deroule selon conditions multiples

Bonjour,
je bloque toujours sur le test de la cellule qui est modifié et qui declenchera la macro, et aussi sur le test de l'existance de la cellule.

D'avance merci pour votre aide

 

[Rhochat]

Re : Liste deroule selon conditions multiples

Finalement j'ai reussi à me debrouiller. Pour ceux que ca interesse voici mon code final. Je pense qu'il n'ai pas optimisé mais bon ce sera plus tard...

Dim flag As Boolean
Private Sub Worksheet_Calculate()

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'pour eviter de reboucler la macro a chaque changement
If flag Then Exit Sub
flag = True

'test si la cellule appartient à la plage session la macro est declenchée
Set plageSession = Range("session")
If Not Intersect(plageSession, Target) Is Nothing Then

'Initialisation de variable
nomListe = "Liste_" & Target.Value

'test si la liste existe
On Error GoTo suite

'Effacement de la LISTE
Application.ScreenUpdating = False
Sheets("feuil1").Range(nomListe).ClearContents
Application.ScreenUpdating = True
existance = True

suite:
'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 la 4eme ligne a la derniere ligne de la colonne A
'modifier dans fichier final de la colonne B
For n = 4 To Sheets("Agences-utilisateurs").Range("A65536").End(xlUp).Row
'recherche dans la ligne n le contenu de la formation
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

If existance = True Then
'Suppression de la LISTE avant redefinition
ActiveWorkbook.Names(nomListe).Delete
End If

'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


salle = Sheets("Planning de formation").Cells(Target.Row, 1).Value
debutRecherche = Target.Row + 1
'recherche de la bonne salle
For n = debutRecherche To Sheets("Planning de formation").Range("A65536").End(xlUp).Row
'si la salle de la cellule modifiee est la meme la liste est affecte
If Sheets("Planning de formation").Cells(n, 1).Value = salle Then
nbStagiaireMax = n
'affectation de la liste aux cellules concernées
Do While Cells(nbStagiaireMax, 2) <> ""
With Cells(nbStagiaireMax, Target.Column).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=" & nomListe
End With
nbStagiaireMax = nbStagiaireMax + 1
Loop
End If
Next n

End If

'on libere le drapeau qui evite le rebouclage de la macro
flag = False
End Sub