为什么我的下拉列表宏只在某些时候起作用？ [英] Why does my macro for the dropdownlists only work sometimes?

问题描述

我制作了一个宏，让用户使用下拉列表(例如，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 = "$B$199" Or Target.Address = "$B$200" Or Target.Address = "$B$201" Or Target.Address = "$B$202" _
Or Target.Address = "$B$203" Or Target.Address = "$B$204" Or Target.Address = "$B$205" Or Target.Address = "$B$206" _
Or Target.Address = "$B$207" Or Target.Address = "$B$208" Or Target.Address = "$B$209" Or Target.Address = "$B$210" _
Or Target.Address = "$B$211" Or Target.Address = "$B$212" Or Target.Address = "$B$213" Or Target.Address = "$B$214" _
Or Target.Address = "$B$215" Or Target.Address = "$B$216" Or Target.Address = "$B$217" Or Target.Address = "$B$218" _
Or Target.Address = "$B$223" Or Target.Address = "$B$224" Or Target.Address = "$B$225" Or Target.Address = "$B$226" _
Or Target.Address = "$B$227" Or Target.Address = "$B$228" Or Target.Address = "$B$229" Or Target.Address = "$B$230" _
Or Target.Address = "$B$231" Or Target.Address = "$B$232" Or Target.Address = "$B$233" Or Target.Address = "$B$234" _
Or Target.Address = "$B$235" Or Target.Address = "$B$236" Or Target.Address = "$B$237" Or Target.Address = "$B$238" _
Or Target.Address = "$B$239" Or Target.Address = "$B$240" Or Target.Address = "$B$241" Or Target.Address = "$B$242" _
Or Target.Address = "$B$243" _
Or Target.Address = "$B$247" Or Target.Address = "$B$248" Or Target.Address = "$B$249" Or Target.Address = "$B$250" _
Or Target.Address = "$B$251" Or Target.Address = "$B$252" Or Target.Address = "$B$253" Or Target.Address = "$B$254" _
Or Target.Address = "$B$255" Or Target.Address = "$B$256" Or Target.Address = "$B$257" Or Target.Address = "$B$258" _
Or Target.Address = "$B$259" Or Target.Address = "$B$260" Or Target.Address = "$B$261" _
Or Target.Address = "$B$266" Or Target.Address = "$B$267" Or Target.Address = "$B$268" Or Target.Address = "$B$269" _
Or Target.Address = "$B$270" Or Target.Address = "$B$271" Or Target.Address = "$B$272" Or Target.Address = "$B$273" _
Or Target.Address = "$B$274" Or Target.Address = "$B$275" _
Or Target.Address = "$F$120" 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 = "$C$199" Or Target.Address = "$C$200" Or Target.Address = "$C$201" Or Target.Address = "$C$202" _
Or Target.Address = "$C$203" Or Target.Address = "$C$204" Or Target.Address = "$C$205" Or Target.Address = "$C$206" _
Or Target.Address = "$C$207" Or Target.Address = "$C$208" Or Target.Address = "$C$209" Or Target.Address = "$C$210" _
Or Target.Address = "$C$211" Or Target.Address = "$C$212" Or Target.Address = "$C$213" Or Target.Address = "$C$214" _
Or Target.Address = "$C$215" Or Target.Address = "$C$216" Or Target.Address = "$C$217" Or Target.Address = "$C$218" _
Or Target.Address = "$C$223" Or Target.Address = "$C$224" Or Target.Address = "$C$225" Or Target.Address = "$C$226" _
Or Target.Address = "$C$227" Or Target.Address = "$C$228" Or Target.Address = "$C$229" Or Target.Address = "$C$230" _
Or Target.Address = "$C$231" Or Target.Address = "$C$232" Or Target.Address = "$C$233" Or Target.Address = "$C$234" _
Or Target.Address = "$C$235" Or Target.Address = "$C$236" Or Target.Address = "$C$237" Or Target.Address = "$C$238" _
Or Target.Address = "$C$239" Or Target.Address = "$C$240" Or Target.Address = "$C$241" Or Target.Address = "$C$242" _
Or Target.Address = "$C$243" _
Or Target.Address = "$C$247" Or Target.Address = "$C$248" Or Target.Address = "$C$249" Or Target.Address = "$C$250" _
Or Target.Address = "$C$251" Or Target.Address = "$C$252" Or Target.Address = "$C$253" Or Target.Address = "$C$254" _
Or Target.Address = "$C$255" Or Target.Address = "$C$256" Or Target.Address = "$C$257" Or Target.Address = "$C$258" _
Or Target.Address = "$C$259" Or Target.Address = "$C$260" Or Target.Address = "$C$261" _
Or Target.Address = "$C$266" Or Target.Address = "$C$267" Or Target.Address = "$C$268" Or Target.Address = "$C$269" _
Or Target.Address = "$C$270" Or Target.Address = "$C$271" Or Target.Address = "$C$272" Or Target.Address = "$C$273" _
Or Target.Address = "$C$274" Or Target.Address = "$C$275" 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

推荐答案

尝试

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

这篇关于为什么我的下拉列表宏只在某些时候起作用？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！