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 but after And operator Not were missing. 这样，为了工作，我应该在单独的列中编辑 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 & ", " & 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