Выборочный выпадающий список в Excel

Question

Привет, я работаю над проектом, основанным на ротации, и пытаюсь заставить работать выпадающее меню, которое выбирает только определенные записи на основе критериев. Обычно в A2 вы вводите время начала смены, а в A3 - время окончания смены. В А1 я хочу, чтобы в раскрывающемся меню были только те сотрудники, которые доступны для этой смены. Все это будет на листе 1. На листе 2 у меня есть весь персонал и его возможности. Лист 2 содержит все подробности в отдельных столбцах, поэтому имя указано в столбце A, доступно для понедельника - в столбце B, доступно до понедельника в столбце C и так далее в течение всей недели. Я сделал макрос (показан ниже), который собирает имена, и я проверил его, чтобы увидеть, работает ли он (что он делает). Есть ли способ получить результаты этого макроса для вывода в выпадающее меню или есть формула, которая может сделать это вместо использования макроса. Любая помощь будет принята с благодарностью

Sub FridayShifts()

Dim StaffAvailabilty As Range                                       'Staff table'
Dim StaffName As Range                                              'Current staff row'
Dim StaffList As Collection                                         'Drop down list'
Dim StartTime As Double                                             'Start time'
Dim EndTime As Double                                               'End time'

Set StaffAvailabilty = Sheets("STAFF").Range("A2:Q42").Rows         'Create the staff table'
Set StaffList = New Collection                                      'Creates a new collection for drop down'
StartTime = ActiveCell.Offset(0, 1) * 86400                         'Gets the shift start time'
EndTime = ActiveCell.Offset(0, 2) * 86400                           'Gets the shift end time'

For Each StaffName In StaffAvailabilty                              'Run through each row on the table'
If IsEmpty(StaffName.Columns(1).Value) = False Then                 'If there is a name (check first column not empty)'
    If IsEmpty(StaffName.Columns(4).Value) = False Then             'If staff member is available (check fourth column has a value'
        If StaffName.Columns(4).Value * 86400 <= StartTime Then     'If staff start time is less or equal to shift start time'
            If StaffName.Columns(5).Value * 86400 >= EndTime Then   'If staff finish time is greater or equal to shift end time'
                StaffList.Add (StaffName.Columns(1).Value)          'Add the value to the drop down'
                MsgBox (StaffName.Columns(1).Value)                 'Test to display staff members is working'
                End If
            End If
        End If
    End If
Next

MsgBox (StaffList.Count)                                            'Test to display total staff members is working'

End Sub

Answer 1

Замените MsgBox (StaffList.Count) на

ValidationFromCollection StaffAvailabilty, StaffList, StaffAvailabilty.Range("A1")

и используйте следующую функцию:

Sub ValidationFromCollection(sh As Worksheet, collect As Collection, rngVal As Range)
  Dim lastCol As Long, El As Variant, i As Long
  i = 1

  lastCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column + 1
  For Each El In collect
    sh.Cells(i, lastCol).value = El
    i = i + 1
  Next
  With rngVal.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
            Operator:=xlBetween, Formula1:="=" & sh.Name & "!" & _
                sh.Range(sh.Cells(1, lastCol), sh.Cells(i - 1, lastCol)).Address
    .IgnoreBlank = True
    .InCellDropdown = True
    .ShowInput = True
    .ShowError = True
  End With
End Sub

Answer 2

Вот альтернатива отличному подходу FaneDuru . Для раскрывающегося списка DV используется строка, разделенная запятыми:

Sub CollectionToDV()
    Dim col As Collection, ci, DVstring As String

    Set col = New Collection
    col.Add "Larry"
    col.Add "Moe"
    col.Add "Curly"
'''''''''''''''''''''''''''''''''''''''''''''''''
    DVstring = ""

    For Each ci In col
        DVstring = DVstring & IIf(DVstring = "", "", ",") & ci
    Next ci

    With ActiveCell.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=DVstring
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub