Microsoft 365 Liste déroulante avec tri

[pompaero]

Bonjour le Forum,

Tout d’abord, je vous souhaite mes meilleurs vœux pour l’année 2021.

En cours d’amélioration d’un de mes programmes, je vous joins un fichier à titre d’exemple qu’il me faut ensuite retranscrire sur mon programme initial.
J’aimerai créer une fiche d’enregistrement des séances de formation effectuées (onglet MC_For), le principe est d’y renseigner les différents items nécessaire (Date, Nature For, Module, Durée, Formateur, Evaluateur, Nom agent, déroulé…).
Pour se faire, concernant les « Nom agents, Formateur et Evaluateur » j’aimerai avoir une liste qui tri les agents après chaque sélection de manière à ne pas avoir de doublon, c’est-à-dire en B17 nous sélectionnons un agent puis en B20 nous sélectionnons un agent mais celui en B17 n’est plus dans la liste et ainsi de suite pour G10, G11, etc….
Ce principe est en place pour test à mon niveau mais je trouve ça brouillon, perso. Est-il possible d’avoir de l’aide la dessus ?
Dans ces mêmes cellules, si vite pourvoir inscrire « Sélection » de manière à pouvoir remettre l’image de l’émargement à blanc (vide).
Je reste à disposition pour tout renseignement, si besoin.

Ci-joint le lien d'accès : https://www.cjoint.com/c/KAnrmcVstoL

Merci à vous
pompaero

 

[Rouge]

Bonjour,

Dans le module VBA de la feuille "MC_For"

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_AgentReste_2 As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set f1 = Sheets("Param")
    Set f2 = Sheets("MC_For")
    
    If Target.Address = "$B$17" Or Target.Address = "$B$20" Or Not Intersect(Target, Range("G10:G29")) Is Nothing Then
        Agent = Target.Value
        f1.Select
        DerLig_AgentReste_2 = f1.Range("Z" & Rows.Count).End(xlUp).Row
        With f1.Range("Z1:Z" & DerLig_AgentReste_2)
            Set a = .Find(Agent, lookat:=xlWhole)
            If Not a Is Nothing Then
                .Cells(a.Row, 1).Select
                Selection.Delete Shift:=xlUp
            End If
        End With
    End If
    f2.Select
    Application.EnableEvents = True
End Sub

Dans le module1 standard

Sub Effacer_liste()
    'déclaration des variables
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_AgentReste As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("Param")
    Set f2 = Sheets("MC_For")
    
    'Demande de confirmation avant d'effacer
    If MsgBox("Etes-vous sûr de vouloir effacer la liste ci-dessous?", vbYesNo + vbCritical + vbDefaultButton2, "Effacer liste") = vbNo Then Exit Sub
    f2.Range("G10:G29, B17, B20").ClearContents 'on efface les précédents résultats
    
    f1.Select
    'on réécrit en P2, la formule ùmatricielle qui construit la liste des agents
    f1.Range("P2").FormulaArray = "=IF(ROWS(R1:R[-1])<=COUNTA(AgentTous)-COUNTA(AgentChoisis),INDEX(AgentTous,SMALL(IF((COUNTIF(AgentChoisis,AgentTous)=0),ROW(INDIRECT(""1:""&ROWS(AgentTous)))),ROWS(R1:R[-1]))),"""")"
    f1.Range("P2").AutoFill Destination:=Range("P2:P16"), Type:=xlFillDefault 'on étire la formule jusqu'à P16
    
    'on reconstruit les listes des Agents
    ActiveWorkbook.Names("AgentReste").Delete 'on efface la liste "AgentReste"
    ActiveWorkbook.Names("AgentReste_2").Delete 'on efface la liste "AgentReste_2"
    DerLig_AgentReste = f1.Range("P" & Rows.Count).End(xlUp).Row 'Dernière ligne de la liste "AgentReste"
    
    'on fait une copie de la liste des agents, c'est dans cette liste que seront retirés les agents déjà sélectionnés auparavant
    f1.Range("P2:P" & DerLig_AgentReste).Select 'on sélectionne la zone sur laquelle va s'appliquer la nouvelle liste "AgentsReste"
    ActiveWorkbook.Names.Add Name:="AgentReste", RefersToR1C1:="=Param!R2C16:R" & DerLig_AgentReste & "C16" 'on recrée la liste "AgentReste"
    
    f1.Range("P2:P" & DerLig_AgentReste).Copy
    f1.Range("Z2:Z" & DerLig_AgentReste).PasteSpecial Paste:=xlPasteValues  'on copie la liste "AgentReste" vers la zone "AgentReste_2" en colonne Z
    
    ActiveWorkbook.Names.Add Name:="AgentReste_2", RefersToR1C1:="=Param!R2C26:R" & DerLig_AgentReste & "C26" 'on recrée la liste "AgentReste_2"
    f2.Select
    
    'on libère la mémoire
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Sur la feuille "MC_For", j'ai ajouté un bouton pour effacer les listes des agents sélectionnés.
Je n'ai pas touché à la réinitialisation des émargements, je vous laisse le soin de la faire.
Cdlt

 

[riton00]

Bonjour,

Un essais en formule.... par contre pour voir afficher sélection automatiquement lors d'une suppression d'une personne dans la colonne B ou G activer les macros "voir Alt+ F11 dans onglet MC_For"

Slts

 

[pompaero]

Bonjour Rouge, riton00

D'abord merci à vous d'avoir pris le temps d'analysé ma demande.
Rouge :
Ta proposition est super intéressante dont j'ai tenté comme d'améliorer en insérant la partie "Sélection" à inscrire dans les cellules vide.
J'avoue m'avoir un peu torturé le cerveau pendant quelque temps sans avoir un résultat correct.
Entre temps est arrivée riton00, qui propose un résultat principalement par formule et et correspond exactement à mon attente sur le principe de fonctionnement.
Du coup, je pars sur la solution de riton00 mais garde sous le coude tout de même ta proposition Rouge.

Je n'ai plus qu'à reproduire la même chose sur mon fichier initial maintenant puis poursuivre son évolution, peut-être à bientôt.
Encore merci à vous, bonne fin de journée.

Cdlt
pompaero