Epurer le menu déroulant

bonjour a tous.

je vous joint un fichier pour lequel j'ai une question.

dans le 1er fichier, il y a les menus déroulant et dans le deuxième, la liste des personnes.

quand certaines personnes sont absente, je me retrouve avec un menu qui comporte plein de blanc.

est il possible d'avoir quand certaines personnes de la liste sont absente, d'avoir un menu déroulant sans blanc.

voila la formule que j’utilise avec validation de données.

='S1 - Agent'!$Y$14:$Y$195

merci a vous


le fichier!

15listes.xlsx (10.89 Ko)

Bonjour et joyeux Noël !

Un essai avec macro à tester.

Il doit y avoir mieux avec formule mais ce n'est pas ma tasse de thé. Je laisse ça à plus compétent que moi.

Cela te convient-il ?

Bye !

20listes-v1.xlsm (19.61 Ko)

bonsoir gmb et joyeux noël

la macro fonctionne mais le problème est qu'il me faut de instantané, si j'ajoute un nom, il n'apparait pas tous de suite avec la macro.

mais le principe est très bien car sa allège le fichier.

Cordialement

bonjour

salut GMB

2 propositions de noel

26eric3333.xlsx (16.87 Ko)

cordialement

bonjour

merci pour cette solution tulipe_4

ça me convient

je te remercie

Cordialement

Bonjour Tulipe

Une nouvelle fois, je m'incline ... Mais où vas-tu chercher tout ça ?

Bye ! et passe de bonnes fêtes !

merci Gmb

reponse : dans mon cerveau " fait-con"

mais c'est toujours la meme salade

- PETITE VALEUR qui trie dans une matrice de n° de LIGNE obtenue avec n'importe quel procédé ; pourvu qu'il soit efficient

c'est votre (cpt+1)

cordialement

bonjour a tous

suite a cette formule qui fonctionne très bien, il m'est impossible de la reporter sur mon fichier, cela ne fonctionne pas.

je vois que les formule on des parenthèses { } qui disparaissent après copie je zap surement quelques chose.

si quelqu'un peux me donner un coup de pousse.

cette formule trie une liste de nom afin de supprimer les blancs du menu déroulant.

Cordialement

Bonsoir et merci pour votre aide.

Existe t il un autre moyen de trier car mon fichier est partager et avec les formules matricielle cela ne fonctionne pas.

Cordialement

J'ai vu une macro mais je ne sais pas l'adapter à mon fichier

Bonsoir,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("A3:A23")) Is Nothing And Target.Count = 1 Then
        Set d = CreateObject("Scripting.Dictionary")
        For Each c In Sheets("S1 - Agent").Range("C4:C130")
            If c.Value <> "" Then d(c.Value) = ""
        Next c
        Target.Validation.Delete
        Target.Validation.Add xlValidateList, Formula1:=Join(d.keys, ",")
    End If
End Sub

On peut faire une version trié

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("A3:A23")) Is Nothing And Target.Count = 1 Then
        Set d = CreateObject("Scripting.Dictionary")
        For Each c In Sheets("S1 - Agent").Range("C4:C130")
            If c.Value <> "" Then d(c.Value) = ""
        Next c
        b = d.keys
        Call tri(b, LBound(b), UBound(b))
        For Each c In b: temp = temp & c & ",": Next c
        Target.Validation.Delete
        Target.Validation.Add xlValidateList, Formula1:=Join(b, ",")
    End If
End Sub

Sub tri(a, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call tri(a, g, droi)
  If gauc < d Then Call tri(a, gauc, d)
End Sub

Ceuzin

17dvjb.xlsm (19.54 Ko)

Bonsoir Ceuzin

et merci, pour moi cela reste la meilleur solution pour évité d'alourdir mon fichier.

je met en retour le meme fichier que je viens de modifier pour essais.

est il possible d'adapter cette formule au classeur complet sachant que les mise en forme sont identique.

les feuilles vont de S1 - prog S1 - agent a S26 - prog a S26 - agent, bien sur les menu déroulant doivent correspondre aux nom dans les feuilles qui sont associées S1 prog et S1 agent etc.

le but est que je puisse ensuite mettre mon fichier en partage et cela ne fonctionne pas si je met la macro pour chaque feuille.

Encore merci pour l'aide.

Cordialement

10dvjb-copie.xlsm (33.25 Ko)

Bonjour,

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  If UCase(Right(ActiveSheet.Name, 4)) <> "PROG" Then Exit Sub
  a = Split(ActiveSheet.Name, "-")
  nf = a(0) & "- agent"
  col = Target.Column
  If Not Intersect(Target, Range("A3:g23")) Is Nothing And Target.Count = 1 Then
        Set d = CreateObject("Scripting.Dictionary")
        For Each c In Sheets(nf).Range("c4:c130").Offset(, col - 1)
            If c.Value <> "" Then d(c.Value) = ""
        Next c
        If d.Count > 0 Then
          b = d.keys
          Call tri(b, LBound(b), UBound(b))
          Target.Validation.Delete
          Target.Validation.Add xlValidateList, Formula1:=Join(b, ",")
        End If
    End If
End Sub

Sub tri(a, gauc, droi) ' Quick sort
 ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call tri(a, g, droi)
  If gauc < d Then Call tri(a, gauc, d)
End Sub

Ceuzin

Bonjour ceuzin

Félicitation pour se travail remarquable,je viens de le mettre en place sur mon fichier, je vais apporter quelques ajouts et je le reposterais par la suite.

par contre je rencontre un erreur 1004 quand je met le fichier en partage et que je sélectionne dans le menu déroulant.

Cordialement

bonjour le forum

je me retrouve avec une erreur bien connu pour certain, la 1004 en mode partage sur la macro suivante:

D’où ma question, existe t il une solution.

merci a tous

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

If UCase(Right(ActiveSheet.Name, 4)) <> "PROG" Then Exit Sub

a = Split(ActiveSheet.Name, "-")

nf = a(0) & "- agent"

col = Target.Column

If Not Intersect(Target, Range("A3:g23")) Is Nothing And Target.Count = 1 Then

Set d = CreateObject("Scripting.Dictionary")

For Each c In Sheets(nf).Range("c4:c130").Offset(, col - 1)

If c.Value <> "" Then d(c.Value) = ""

Next c

If d.Count > 0 Then

b = d.keys

Call tri(b, LBound(b), UBound(b))

Target.Validation.Delete

Target.Validation.Add xlValidateList, Formula1:=Join(b, ",")

End If

End If

End Sub

Sub tri(a, gauc, droi) ' Quick sort

ref = a((gauc + droi) \ 2)

g = gauc: d = droi

Do

Do While a(g) < ref: g = g + 1: Loop

Do While ref < a(d): d = d - 1: Loop

If g <= d Then

temp = a(g): a(g) = a(d): a(d) = temp

g = g + 1: d = d - 1

End If

Loop While g <= d

If g < droi Then Call tri(a, g, droi)

If gauc < d Then Call tri(a, gauc, d)

End Sub

bonjour a tous

après plusieurs rechercher, je ne trouve pas le miracle qui pourrait faire fonctionner la macro en mode partage.

si quelqu’un peux m'aiguiller a savoir si je dois me retourner vers des formules plutôt que la macro en mode partage.

bonne journée a tous

bien cordialement

Eric

Bonjour,

Je pense que tu dois partager ton classeur qu'une fois celui-ci finalisé avec tes macros.

Et encore que...

Cdlt.

Bonjour le forum

voici mon fichier finalisé avec la macro intégrée,je le partage en deux liens,la macro est sur le fichier 08_PREV NUIT 2016 S01 - S26

en lien avec le fichier 09_PLANNING AGENT 2016 S01 - S26.

il y a des feuilles cachées dans le fichier 08_PREV NUIT 2016 S01 - S26 avec des formules qui sont en lien avec 09_PLANNING AGENT 2016 S01 - S26

cela fonctionne mais je rencontre quelques soucis.

A l'ouverture du fichier avec la macro, j'ai une erreur qui me demande de réparer le fichier.

Enregistrements réparés: Formule dans la partie /xl/worksheets/sheet2.bin

Enregistrements réparés: Formule dans la partie /xl/worksheets/sheet4.bin

Ensuite je ne peux pas le mettre en partage, erreur lors de l'utilisation des listes déroulantes.

la partie n°1

https://www.cjoint.com/c/FBkft44Yu45

la partie n°2

je vous remercie par avance pour votre aide.

Cordialement

8error014880-01.xml (531.00 Octets)
5error080560-01.xml (531.00 Octets)
Rechercher des sujets similaires à "epurer menu deroulant"