Beberapa pilihan daftar dropdown di excel

Question

Saya punya buku kerja dengan banyak (lebih dari 50) lembar di dalamnya. Dalam 49 lembar, ada lebih banyak atau lebih sedikit daftar dropdown di kolom E. Jika ada dropdown list, maka source list bergantung pada sel C di baris yang sama. Jadi tergantung pada mis. C11, E11 akan menjadi dropdownlist1, dropdownlist2 atau kosong. Sekarang di masing-masing 49 lembar, saya ingin membuat daftar turun-bawah2 global menjadi daftar pilihan berganda. Di bawah ini adalah kode saya:

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 

Sekarang jika kode ini ada di This_workbook sepertinya tidak berfungsi, dan jika saya memasukkan whats di bawah ini ke dalam lembar vba tertentu, Worksheet_Changeitu berfungsi. Juga, untuk saat ini, kode ini akan berfungsi untuk keduanya, dropdownlist1 dan dropdownlist2. Bagaimana cara memperbaikinya?

Answer 1

Jadi dalam kode saya ada kesalahan. Sepanjang waktu saya mengacu pada sel tunggal, yang diperiksa oleh: If Not Target.Rows.Count > 1 And Target.Columns.Count > 1 Thentetapi setelah operator Dan Tidak hilang. Dengan cara itu, agar berfungsi, saya harus mengedit lebih dari 1 sel di kolom terpisah. Kode di bawah sudah diperbaiki.

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