excel中的多选下拉列表

Question

我有很多（超过 50 张）工作簿。在 49 张表中，E 列中有或多或少的下拉列表。如果有下拉列表，则列表的来源取决于同一行的 C 单元格。所以取决于例如。 C11、E11 将为 dropdownlist1、dropdownlist2 或空白。现在在 49 张表中，我想让 globaly dropdownlist2 成为多选列表。以下是我的代码：

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 & ", " & 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。我该如何解决？

Answer 1

所以在我的代码中是错误的。我一直在指的是单个单元格，它通过以下方式检查：If Not Target.Rows.Count > 1 And Target.Columns.Count > 1 Then 但在 And 运算符 Not 丢失之后。这样，为了工作，我应该在单独的列中编辑多个单元格。下面的代码是固定的。

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 & ", " & 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