为什么我的下拉列表宏有时只起作用？

Question

我制作了一个宏，让用户可以使用下拉列表（例如 1、2、3），每次选择一个值时，带有下拉列表的单元格中都会显示格式化的概览（例如 2 - 1 - 3）。我为两个不同的下拉列表做了这个。当我今天早上打开它时，宏不再工作并继续显示当前选择的值但忘记了旧值。它似乎有时有效，有时却无效。谁能告诉我哪里出错了？

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'Declaration of the var
Dim Oldvalue As String
Dim Newvalue As String
Dim OldvalueTPR As String
Dim NewvalueTPR As String

Application.EnableEvents = True
On Error GoTo Exitsub
'first dropdown
If Target.Address = "$B9" Or Target.Address = "$B0" Or Target.Address = "$B1" Or Target.Address = "$B2" _
Or Target.Address = "$B3" Or Target.Address = "$B4" Or Target.Address = "$B5" Or Target.Address = "$B6" _
Or Target.Address = "$B7" Or Target.Address = "$B8" Or Target.Address = "$B9" Or Target.Address = "$B0" _
Or Target.Address = "$B1" Or Target.Address = "$B2" Or Target.Address = "$B3" Or Target.Address = "$B4" _
Or Target.Address = "$B5" Or Target.Address = "$B6" Or Target.Address = "$B7" Or Target.Address = "$B8" _
Or Target.Address = "$B3" Or Target.Address = "$B4" Or Target.Address = "$B5" Or Target.Address = "$B6" _
Or Target.Address = "$B7" Or Target.Address = "$B8" Or Target.Address = "$B9" Or Target.Address = "$B0" _
Or Target.Address = "$B1" Or Target.Address = "$B2" Or Target.Address = "$B3" Or Target.Address = "$B4" _
Or Target.Address = "$B5" Or Target.Address = "$B6" Or Target.Address = "$B7" Or Target.Address = "$B8" _
Or Target.Address = "$B9" Or Target.Address = "$B0" Or Target.Address = "$B1" Or Target.Address = "$B2" _
Or Target.Address = "$B3" _
Or Target.Address = "$B7" Or Target.Address = "$B8" Or Target.Address = "$B9" Or Target.Address = "$B0" _
Or Target.Address = "$B1" Or Target.Address = "$B2" Or Target.Address = "$B3" Or Target.Address = "$B4" _
Or Target.Address = "$B5" Or Target.Address = "$B6" Or Target.Address = "$B7" Or Target.Address = "$B8" _
Or Target.Address = "$B9" Or Target.Address = "$B0" Or Target.Address = "$B1" _
Or Target.Address = "$B6" Or Target.Address = "$B7" Or Target.Address = "$B8" Or Target.Address = "$B9" _
Or Target.Address = "$B0" Or Target.Address = "$B1" Or Target.Address = "$B2" Or Target.Address = "$B3" _
Or Target.Address = "$B4" Or Target.Address = "$B5" _
Or Target.Address = "$F0" Then

  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

'Second dropdown different format
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "$C9" Or Target.Address = "$C0" Or Target.Address = "$C1" Or Target.Address = "$C2" _
Or Target.Address = "$C3" Or Target.Address = "$C4" Or Target.Address = "$C5" Or Target.Address = "$C6" _
Or Target.Address = "$C7" Or Target.Address = "$C8" Or Target.Address = "$C9" Or Target.Address = "$C0" _
Or Target.Address = "$C1" Or Target.Address = "$C2" Or Target.Address = "$C3" Or Target.Address = "$C4" _
Or Target.Address = "$C5" Or Target.Address = "$C6" Or Target.Address = "$C7" Or Target.Address = "$C8" _
Or Target.Address = "$C3" Or Target.Address = "$C4" Or Target.Address = "$C5" Or Target.Address = "$C6" _
Or Target.Address = "$C7" Or Target.Address = "$C8" Or Target.Address = "$C9" Or Target.Address = "$C0" _
Or Target.Address = "$C1" Or Target.Address = "$C2" Or Target.Address = "$C3" Or Target.Address = "$C4" _
Or Target.Address = "$C5" Or Target.Address = "$C6" Or Target.Address = "$C7" Or Target.Address = "$C8" _
Or Target.Address = "$C9" Or Target.Address = "$C0" Or Target.Address = "$C1" Or Target.Address = "$C2" _
Or Target.Address = "$C3" _
Or Target.Address = "$C7" Or Target.Address = "$C8" Or Target.Address = "$C9" Or Target.Address = "$C0" _
Or Target.Address = "$C1" Or Target.Address = "$C2" Or Target.Address = "$C3" Or Target.Address = "$C4" _
Or Target.Address = "$C5" Or Target.Address = "$C6" Or Target.Address = "$C7" Or Target.Address = "$C8" _
Or Target.Address = "$C9" Or Target.Address = "$C0" Or Target.Address = "$C1" _
Or Target.Address = "$C6" Or Target.Address = "$C7" Or Target.Address = "$C8" Or Target.Address = "$C9" _
Or Target.Address = "$C0" Or Target.Address = "$C1" Or Target.Address = "$C2" Or Target.Address = "$C3" _
Or Target.Address = "$C4" Or Target.Address = "$C5" Then
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
    Else: If Target.Value = "" Then GoTo Exitsub Else
        Application.EnableEvents = False
        NewvalueTPR = Target.Value
        Application.Undo
        OldvalueTPR = Target.Value
        If OldvalueTPR = "" Then
            Target.Value = NewvalueTPR
        Else
         If InStr(1, OldvalueTRP, NewvalueTPR) = 0 Then
            Target.Value = OldvalueTPR & vbNewLine & NewvalueTPR
        Else:
            Target.Value = OldvalueTPR
        End If
     End If
    End If
End If
Application.EnableEvents = True
Exitsub:
End Sub

Answer 1

尝试

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    
    On Error Resume Next
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
        Exit Sub
    End If
    On Error GoTo 0
   
    Dim oldvalue, newvalue, sep As String
    Dim rng1 As Range, rng2 As Range
    
    Set rng1 = Range("B199:B218,B223:B243,B247:B261,B266:B275,F120")
    Set rng2 = Range("C199:C218,C223:C243,C247:C261,C266:C275")
    
    If Not Application.Intersect(Target, rng1) Is Nothing Then
        sep = " - "
    ElseIf Not Application.Intersect(Target, rng2) Is Nothing Then
        sep = vbNewLine
    Else
        Exit Sub
    End If
    
    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 & sep & newvalue
        Else
            Target.Value = oldvalue
        End If
    End If
    Application.EnableEvents = True
        
End Sub

为什么我的下拉列表宏有时只起作用？

Why does my macro for the dropdownlists only work sometimes?

excel

vba

dropdown