如何在 Excel 中创建动态下拉列表

Question

我有一个电子表格，我正在尝试在其中创建一个动态下拉列表。我已对其进行了设置，以便我有一个 Test No. 列表和旁边的星期几。它看起来像这样：

现在我想要的是，当我在其中一个列表下添加相同的数字时，我希望下拉列表只为我提供尚未用于该数字的可用天数。

即对于1234，New 下的下拉菜单应该有 Thu、Fri、Sat、Sun 即对于5678，New 下的下拉菜单应该有 Mon、Wed、Thu、Sat、Sun 即对于9012，New 下的下拉菜单应该有 tue, Sat, Sun

我有一个命名范围，其中包含一周中的 7 天，我可以使用数据验证让该列表成为删除选项，但我希望它是动态的，并且只给我尚未使用的选项那个Test No。

这可以吗？

Answer 1

假设您的数据在 A:B 列中，其中 row1 是标题行，并且您有一个名为 Days 的命名范围，然后右键单击工作表选项卡 --> 查看代码并将下面给出的代码粘贴到打开的代码窗口 --> 将您的工作簿另存为启用宏的工作簿。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim x, dict
Dim i As Long, lr As Long
Dim Rng As Range, Cell As Range
Dim Str As String
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Range("A2:A" & lr)
x = Range("Days").Value
Set dict = CreateObject("Scripting.Dictionary")
If Target.Column = 2 And Target.Row > 1 Then
    If Target.Offset(0, -1) <> "" Then
        For Each Cell In Rng
            If Cell <> "" And Cell = Target.Offset(0, -1) Then
                If Str = "" Then
                    Str = Cell.Offset(0, 1).Value
                Else
                    Str = Str & ", " & Cell.Offset(0, 1).Value
                End If
            End If
        Next Cell
        For i = 1 To UBound(x, 1)
            If InStr(Str, x(i, 1)) = 0 Then
                dict.Item(x(i, 1)) = ""
            End If
        Next i
        On Error Resume Next
        With Target.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                                xlBetween, Formula1:=Join(dict.keys, ",")
        End With
    End If
End If
End Sub

因此，一旦您在 B 列中选择了一个单元格，代码将添加一个下拉列表，其中不包括已为特定测试编号选择的日期。 A列中的相应单元格。

Answer 2

您可以在工作表的代码模块中处理Worksheet_SelectionChange 事件以更改验证列表。需要进行一些检查以查看新选择的单元格是否是您要验证的单元格之一；即 B 列、A 列中的标识符等。下面例程中的检查符合您的示例数据。

' Code Module of your worksheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.count > 1 Then Exit Sub
    If Target.Column <> 2 Or Target.row < 2 Then Exit Sub
    If Len(Trim(Target.Value)) > 0 Then Exit Sub
    If Len(Trim(Target.offset(, -1).Value)) = 0 Then Exit Sub

    Dim newList As String: newList = ",Sun,Mon,Tue,Wed,Thu,Fri,Sat"
    Dim r As Range: Set r = Target.offset(-1)
    Do Until Len(Trim(r.Value2)) = 0 Or r.offset(, -1).Value2 <> Target.offset(, -1).Value2
        newList = Replace(newList, "," & r.Value2, "")
        Set r = r.offset(-1)
    Loop
    With Target.Validation
        .Delete
        .Add xlValidateList, , , Mid(newList, 2)
    End With
End Sub

Answer 3

您可以使用取决于下拉列表
创建您的列表周一-周日定义名称 wkday 例如
选择 Tue--Sunday 并定义名称 Mon
选择周三--周日并定义姓名周二
选择 Thu--Sunday 并定义名称Wed
选择 Fri--Sunday 并定义名称 Thu
选择 Sat--Sunday 并定义名称Fri
选择星期日并定义名称星期六

您可以选择需要下拉列表的所有单元格：
例如下面从单元格 B2 开始，在源代码中创建数据验证列表：

=IF(OR(B1="",B1="Day"),wkday,INDIRECT(B1))