在Excel中启用/禁用下拉列表的单元格

时间:2019-06-14 07:46:20

标签: excel vba dropdown

我创建了一个简单的下拉列表。看起来像这样。

enter image description here

允许用户在此处进行多项选择。

如果用户选择了“不适用”以外的其他选项,则应禁用不适用单元格并启用其他城市进行选择。但是,如果用户首先选择不适用,则其他城市选项应被禁用。同时单击同一单元格将启用和禁用该单元格。

例如第一个用户决定不选择任何国家,因此他单击“不适用”选项,然后自动禁用“纽约,柏林,孟买,慕尼黑”选项。但是稍后,如果用户决定选择“城市”选项,并且如果他再次单击“不适用”,则它将被禁用,而其他国家/地区将被启用。

我也将价值与城市相关联,我正在打印价值。

enter image description here

=SUMPRODUCT(--(ISNUMBER(SEARCH(Sheet2!A2:A6;Sheet1!A2))*Sheet2!B2:B6))

我曾经在网上使用多种选择和删除代码。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    If Target.Count > 1 Then Exit Sub
    On Error Resume Next
    Set xRng = Me.Range("A2")
    If xRng Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If Not Application.Intersect(Target, xRng) Is Nothing Then
        xValue2 = Target.Value
        Application.Undo
        xValue1 = Target.Value
        Target.Value = xValue2
        If xValue1 <> "" Then
            If xValue2 <> "" Then
                If InStr(1, xValue1, xValue2 & ",") > 0 Then
                    xValue1 = Replace(xValue1, xValue2 & ", ", "") ' If it's in the middle with comma
                    Target.Value = xValue1
                    GoTo jumpOut
                End If
                If InStr(1, xValue1, ", " & xValue2) > 0 Then
                    xValue1 = Replace(xValue1, ", " & xValue2, "") ' If it's at the end with a comma in front of it
                    Target.Value = xValue1
                    GoTo jumpOut
                End If
                If xValue1 = xValue2 Then        ' If it is the only item in string
                    xValue1 = ""
                    Target.Value = xValue1
                    GoTo jumpOut
                End If
                Target.Value = xValue1 & ", " & xValue2
            End If
jumpOut:
        End If
    End If
    Application.EnableEvents = True
End Sub

1 个答案:

答案 0 :(得分:0)

尝试以下操作(将其放入带有下拉列表的工作表中的模块中):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim searchNA As Range
Dim LRow As Long

If Not Intersect(Target, Range("A2")) Is Nothing Then
    With ThisWorkbook.Sheets("Sheet2")
        LRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set searchNA = .Range("A2:A" & LRow).Find(Target.Value, lookat:=xlWhole, MatchCase:=True)
        If Target.Value = "Not Applicable" Then
            .Range("A2:A" & LRow).Locked = True
            searchNA.Locked = False
        Else
            .Range("A2:A" & LRow).Locked = False
            searchNA.Locked = True
        End If
    End With
End If
End Sub

我假设验证列表位于Worksheet("Sheet1")中,带有城市的小表位于"Sheet2"