Включить / отключить ячейки раскрывающегося списка в Excel - PullRequest
0 голосов
/ 14 июня 2019

Я создал простой выпадающий список.Это выглядит примерно так:

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 голосов
/ 14 июня 2019

Попробуйте следующее (поместите его в модуль из листа с раскрывающимся списком):

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"

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...