XL 2021 Liste déroulante qui exclu les champs déjà utilisés

[Marie1608]

Bonjour,

J'ai besoin d'aider pour faire un planning excel avec une liste déroulante mais qui enlève les champs déjà utilisé dans la colonne. J'ai regardé sur internet mais dans les tuto il faut masquer la colonne alors que moi je préfère que les "membres" soit sur un autre onglet pour pouvoir en rajouter par la suite plus facilement.

Dans le fichier Excel, j'ai 3 colonnes (marcheur, rond de longe et paddock) le but est qu'une seule personne ne puisse avoir qu'un seul créneau horaire par colonne pour que les gens ne puissent pas prendre + qu'un créneau d'une heure.

Quelqu'un pourrait-il me donner un coup de main ?


Merci d'avance

 

[Marie1608]

Bonjour à tous , juste en passant
Ou avec une liste de validation dynamique
la sub est lancée au selectchange dans une des 3 colonnes et sur 15 lignes

Sub listRestants()
    'patricktoulon
    Dim tblprime, tblexist, li&, li2&
    tblprime = [T_personne].Value 'tblprime c'est le tableau original complet des personnes
    tblexist = ActiveSheet.Cells(2, Selection.Column).Resize(15).Value 'tblexiste c'est le tableau des personne presente dans la colonne de la cellule selectée
  
    For li = 1 To UBound(tblprime)
        'on vide les items de tblprime si il existent dans tblexist
        'et si il sont presents sur la ligne (offset -1 et 1 en colonne)
        For li2 = 1 To UBound(tblexist)
            If tblexist(li2, 1) = tblprime(li, 1) Then tblprime(li, 1) = ""
            If tblprime(li, 1) = Selection.Offset(, -1) Then tblprime(li, 1) = ""
            If tblprime(li, 1) = Selection.Offset(, 1) Then tblprime(li, 1) = ""
        Next
    Next
    With Selection.Validation
        .Delete
        'la liste de validation est remplie avec le join du transpose du tblprime
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                                      xlBetween, Formula1:=Join(Application.Transpose(tblprime), ",")
        .IgnoreBlank = True 'on fait sauter les blancs il y en a forcément au fur et à mesure
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

Merci beaucoup mais j'ai un message d'erreur 424 : objet requis

 

[Marie1608]

Bonjour Marie, Gosselein, Fanfan, TooFatBoy,
Un autre exemple en PJ avec :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Fin
    If Target.Count <> 1 Then Exit Sub
    If Cells(Target.Row, "B") = "" Then Exit Sub
    Dim T, DL%, L%, Lp%, NL%, i%
    T = [ts_Personnes]: Sheets("Personnes").[D3].Resize(UBound(T, 1), UBound(T, 2)) = T
    DL = Cells(Cells.Rows.Count, "B").End(xlUp).Row
    For L = 2 To DL
        Nom = Cells(L, Target.Column)
        If Nom <> "" Then
            Lp = Application.Match(Nom, [ts_PersTempo], 0): [ts_PersTempo].Item(Lp, 1) = ""
        End If
    Next L
    With [ts_PersTempo]
        NL = .ListObject.ListRows.Count
        .Resize(NL).Sort key1:=.Item(1, 1), order1:=xlAscending, Header:=xlYes
        For i = NL To 1 Step -1
            If .Item(i, 1) = "" Then .Item(i, 1).Delete Else Exit For
        Next i
    End With
Fin:
End Sub

Merci beaucoup ça fonctionne au top ! Si je veux rajouter des personnes je n'ai cas les rajouter dans les deux colonnes de l'onglet "personne" c'est bien ça ?
Et pour créer un nouveau jour, puis-je dupliquer simplement l'onglet ? Ou je dois regarder pour créer un bouton macro pour dupliquer ?

 

[Marie1608]

Du coup je refais une proposition (toujours toute moisie ☹️ ) en pièce jointe.

Meri beaucoup par contre j'ai aussi une erreur dans le fichier 1004 : La méthode Range à échoué.

Je vais du coup partir sur le fichier de Sylvanu qui fonctionne 🙂

Merci en tout cas

 

[sylvanu]

Bonsoir,

Si je veux rajouter des personnes je n'ai cas les rajouter dans les deux colonnes de l'onglet "personne"

Non, juste dans la colonne de gauche. La colonne de droite se réajustera automatiquement.

Et pour créer un nouveau jour, puis-je dupliquer simplement l'onglet ?

Exact. Si vous dupliquez l'onglet, vous dupliquez par la même occasion la macro qui est dans la feuille.

 

[patricktoulon]

re:
en effet ,Peut-être qu'effectivement je crois me souvenir que les names de TS ne sont plus accessibles par range sur 64 bits
j'en ai profité pour corriger le test linéaire

Sub listRestants()
    'patricktoulon
    Dim tblprime, tblexist, li&, li2&, sel As Range
    Set sel = Selection
    tblprime = ThisWorkbook.Sheets("Personnes").ListObjects("T_personne").DataBodyRange.Value 'tblprime c'est le tableau original complet des personnes
    tblexist = ActiveSheet.Cells(2, Selection.Column).Resize(15).Value 'tblexiste c'est le tableau des personne presente dans la colonne de la cellule selectée
    
    For li = 1 To UBound(tblprime)
        'on vide les items de tblprime si il existent dans tblexist
        'et si il sont presents sur la ligne (offset -1 et 1 en colonne)
        If sel <> "" And tblprime(li, 1) <> "" Then
        If WorksheetFunction.CountIf(Cells(sel.Row, 3).Resize(1, 3), tblprime(li, 1)) > 0 Then tblprime(li, 1) = ""
        End If
        For li2 = 1 To UBound(tblexist)
            If tblexist(li2, 1) <> "" Then If tblexist(li2, 1) = tblprime(li, 1) Then tblprime(li, 1) = ""
        Next
    Next
    With Selection.Validation
        .Delete
        'la liste de validation est remplie avec le join du transpose du tblprime
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                                      xlBetween, Formula1:=Join(Application.Transpose(tblprime), ",")
        .IgnoreBlank = True 'on fait sauter les blancs il y en a forcement au fur et à mesure
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

 

[AtTheOne]

Bonjour à toutes & à toutes, bonjour @Marie1608
Comme d'habitude un peu tard mais je donne quand même ma proposition :
Utiliser la validation de donnée avec une liste qui varie selon la cellule active, on peut ajouter des onglets par copie de feuille.
Je n'ai pas pu échapper à un peu de macro pour obtenir dynamiquement l'adresse de la cellule active.

les macros

Objet Workbook :

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
     Set MaCell = Target.Cells(1, 1)
     Sh.Calculate
End Sub

La fonction CelluleActive :

Public MaCell As Range
Function CelluleActive() As String
     CelluleActive = MaCell.Address
End Function

voir le fichier joint

À bientôt

 

[TooFatBoy]

Meri beaucoup par contre j'ai aussi une erreur dans le fichier 1004 : La méthode Range à échoué.

Ca plante aussi avec le classeur de #7, ou uniquement avec ton vrai classeur ?
Juste par curiosité, peux-tu indiquer sur quelle ligne ça s'arrête .

Je vais du coup partir sur le fichier de Sylvanu qui fonctionne 🙂

Effectivement c'est plus logique de partir sur un fichier qui fonctionne. Donc tu as bien raison. 👍