☰

检测到模糊名称：添加 2 个更改事件时 Worksheet_Change

tag-icon • tag-icon microsoft-excel vba macros
检测到模糊名称：添加 2 个更改事件时 Worksheet_Change

我在同一张表上有两个代码。一个用于自动刷新数据透视表，另一个用于多选下拉菜单。我已将两个代码添加到一起，但多选下拉菜单不起作用。有什么解决方法吗？仅供参考，这是我添加代码的方式，

Private Sub Worksheet_Change(ByVal Target As Range)

ActiveWorkbook.RefreshAll

End Sub


Private Sub Worksheet_Change(ByVal Target As Range)


Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 18 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
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True


End Sub

PS 我也尝试将两个代码都添加到一个私有子程序中，但没有任何代码运行。

Private Sub Worksheet_Change(ByVal Target As Range)

ActiveWorkbook.RefreshAll


Private Sub Worksheet_Change(ByVal Target As Range)


Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Column = 18 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
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True


End Sub

答案1

不确定您想在什么情况下ActiveWorkbook.RefreshAll运行。目前，只要您更改任何单元格中的值，它就会运行。

尝试此代码。 Option Explicit并且Private OldValue As String必须位于任何程序之前的模块顶部。

Option Explicit

Private OldValue As String

'Record the old value as soon as you enter column 18.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 18 Then
        OldValue = Target.Value
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    'Turn off events otherwise it will run again when Target value is updated.
    Application.EnableEvents = False

    ActiveWorkbook.RefreshAll
    
    If Target.Column = 18 Then
        'Only run if the Target cell has List type validation.
        If CellHasList(Target) Then
            Dim NewValue As String
            NewValue = Target.Value
            
            If InStr(OldValue, NewValue) = 0 Then
                Target.Value = OldValue & ", " & NewValue
            Else
                Target.Value = OldValue
            End If
        End If
    End If
    
    'Turn events back on.
    Application.EnableEvents = True

End Sub

Public Function CellHasList(cell As Range) As Boolean
    
    CellHasList = True
    
    On Error Resume Next
    Dim valType As Long
    valType = cell.Validation.Type 'Will return an error if no validation in Target cell.
    
    'valType = 3 is for List validation.
    If Err.Number <> 0 Or valType <> 3 Then
        CellHasList = False
    End If
    On Error GoTo 0

End Function

相关内容