Выпадающий список с несколькими вариантами выбора в Excel

#excel

Вопрос:

У меня есть рабочая тетрадь со многими (более 50) листами. На 49 листах в столбце E больше или меньше выпадающих списков. Если есть выпадающий список, источник списка зависит от ячейки C в той же строке. Итак, в зависимости от, например. C11, E11 будут выпадающими списками1, выпадающими списками2 или пустыми. Теперь на каждом из 49 листов я хочу сделать глобальный выпадающий список 2 списком с несколькими вариантами выбора. Ниже приведен мой код:

 Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
     If Not Sh.Name = "Dane" Then
        With Sh
            Dim Oldvalue As String
            Dim Newvalue As String
            .Protect UserInterfaceOnly:=True
            Application.EnableEvents = True
            On Error GoTo Exitsub
            ' the check to catch a change of single cell only
            If Not Target.Rows.Count > 1 And Target.Columns.Count > 1 Then
                ' check that this cell in column "E" (concept #2)
                If Not Intersect(Target, .Columns(5)) Is Nothing Then
                    'check if this is validation data cell
                    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
                      GoTo Exitsub
                    Else: If .Target.Value = "" Then GoTo Exitsub Else
                      Application.EnableEvents = False
                      Newvalue = Target.Value
                      Application.Undo
                      Oldvalue = Target.Value
                        If Oldvalue = "" Then
                          Target.Value = Newvalue
                        Else
                            If InStr(1, Oldvalue, Newvalue) = 0 Then
                              Target.Value = Oldvalue amp; ", " amp; Newvalue
                            Else:
                              Target.Value = Oldvalue
                            End If
                        End If
                     End If
                End If
            End If
            Application.EnableEvents = True
        End With
    End If
    
Exitsub:
    Application.EnableEvents = True
    
End Sub

Теперь, если этот код находится в This_workbook, он, похоже, не работает, и если я помещу то, что приведено ниже, в конкретный лист vba, Worksheet_Change это сработает. Кроме того, на данный момент этот код будет работать как для dropdownlist1, так и для dropdownlist2. Как я могу это исправить?

1. Попробуйте прокомментировать строку ошибки on, чтобы узнать, что происходит. И что означает «кажется, не работает»?

2. .Target.Value неверно, этой первой точки не должно быть.

3. Вы можете использовать formula1 свойство, а именно target.validation.formula1 .

4. Он должен отображать именованный диапазон, предполагая, что вы используете список.

5. Так почему бы просто не обратиться к содержимому B14, если оно содержит имя диапазона?

Ответ №1:

Итак, в моем коде была ошибка. Все время я ссылался на одну ячейку, которая была проверена с помощью: If Not Target.Rows.Count > 1 And Target.Columns.Count > 1 Then но после и оператор не отсутствовал. Таким образом, для работы я должен отредактировать более 1 ячейки в отдельных столбцах. Приведенный ниже код исправлен.

 Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
     If Not Sh.Name = "Dane" Then
        With Sh
            Dim Oldvalue As String
            Dim Newvalue As String
            .Protect UserInterfaceOnly:=True
            Application.EnableEvents = True
            On Error GoTo Exitsub
            ' the check to catch a change of single cell only
            If Not Target.Rows.Count > 1 And Not Target.Columns.Count > 1 Then
                ' check that this cell in column "E" (concept #2)
                If Not Intersect(Target, .Columns(5)) Is Nothing Then
                    'check if this is validation data cell
                    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
                      GoTo Exitsub
                    Else: If .Target.Value = "" Then GoTo Exitsub Else
                      Application.EnableEvents = False
                      Newvalue = Target.Value
                      Application.Undo
                      Oldvalue = Target.Value
                        If Oldvalue = "" Then
                          Target.Value = Newvalue
                        Else
                            If InStr(1, Oldvalue, Newvalue) = 0 Then
                              Target.Value = Oldvalue amp; ", " amp; Newvalue
                            Else:
                              Target.Value = Oldvalue
                            End If
                        End If
                     End If
                End If
            End If
            Application.EnableEvents = True
        End With
    End If
    
Exitsub:
    Application.EnableEvents = True
    
End Sub