首页 文章

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

提问于
浏览 次
0

我试图创建一个动态下拉列表 . 我已经设置好了，所以我有一个 Test No. 的列表和它旁边的星期几 . 它看起来像这样：

Setup TestNumbers

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

即对于 1234 ，New下的下降应该是周四，周五，周六，周日，即 5678 新下的下降应该有周一，周三，周四，周六，太阳即为 9012 新下的下降应该有星期六，周六，太阳

我有一个命名范围，一周7天，我可以使用数据验证使该列表成为放置选项，但我希望它是动态的，只给我那些 Test No 尚未使用的选项 .

可以这样做吗？

excel vba excel-formula excel-2010 dropdown

3 回答

  • 1

    假设您的数据位于列A：B中，其中row1是 Headers 行，并且您有一个名为 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栏中的相应单元格.
    enter image description here

    回复于
  • 1

    您可以在工作表的代码模块中处理 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
    回复于
  • 0

    您可以使用依赖下拉列表
    创建列表周一 - 周日定义名称 wkday 例如
    选择星期二 - 星期日和定义名称 Mon
    选择周三 - 周日和定义名称 Tue
    选择星期四 - 星期日和定义名称 Wed
    选择周五 - 周日和定义名称 Thu
    选择周六 - 周日和定义名称 Fri
    选择星期日并定义名称 Sat

    您可以选择需要下拉列表的所有单元格：
    从下面的Cell B2开始，在Source write中创建数据验证，List：

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

    回复于

相关问题