Excel VBA：为什么事件会触发两次？

我试图通过在关键点禁用事件来避免事件循环。然而，它并不总是有效的。例如，组合框的以下代码：

Private Sub TempComboS_Change()
Dim e
e = Application.EnableEvents
Application.EnableEvents = False
  ' 
Application.EnableEvents = e
End Sub

空行是有用代码所在的位置；就目前而言，它显然没有任何作用。但是，当我用空白行这样运行时，它会到达结束子，然后返回到开始并再次运行。这将使有用的代码运行两次

为什么会这样

编辑：为一直在帮助我的人澄清

我有一个宏打开组合框的下拉列表，激活它，然后结束。它工作正常。当我从“打开”列表中选择一个项目时，更改事件将运行。这是更改事件的当前版本：

Private Sub TempComboS_Change()
End Sub

我在私有子行上放置了一个断点。它显示此更改事件运行，然后再次运行。我怀疑它一直在这样做，现在我注意到了，因为我需要在这里添加代码

我没有类模块或用户表单。控件位于工作表上

我将尝试一下Run Once建议，如果有效，我会告诉你

我尝试了你建议的运行代码。这有点奏效，但我似乎有一个更大的问题。当我从数据验证单元格中选择下拉列表时，会触发TempComboS_Change事件-但我不仅没有触摸此组合框，而且该单元格不是组合框的链接单元格。换句话说，它似乎是由与组合框无关的操作触发的

---

必须了解有关调用堆栈的事情…

每当组合框中有更改时，组合框将触发更改。比如说

Option Explicit

Private Sub UserForm_Initialize()
    ComboBox1.AddItem "Bah Blah"
End Sub

Private Sub CommandButton1_Click()
    '~~> If something is selected in the combo then
    '~~> this line will cause ComboBox1_Change to fire
    ComboBox1.Clear
End Sub

Private Sub ComboBox1_Change()
    MsgBox "A"
End Sub

因此，如果加载userform并选择一个项目ComboBox1，则会触发更改。然后使用COMMAN按钮清除组合，ComboBox1\u Change将再次触发

还有一种情况是，更改将再次启动。从ComboBox1\u更改事件本身更改ComboxBox时。这里有一个例子。我相信这就是你的情况

情景1

情景2

在第一个场景中，您可以逃之夭夭

Private Sub UserForm_Initialize()
    ComboBox1.AddItem "Bah Blah"
End Sub

Private Sub ComboBox1_Change()
    If ComboBox1 <> "" Then
        MsgBox "A"
    End If
End Sub

---

下面是一些代码，有助于调查事件顺序问题

在标准模块中

Public Enum eNewLine
    No
    Before
    After
    Both
End Enum

Public Function timeStamp(Optional d As Double = 0, Optional newLine As eNewLine = No, Optional Indent As Long = 0, _
                            Optional Caller As String, Optional Context As String, Optional message As String) As String
Dim errorMessage As String

    If Err.number <> 0 Then
        errorMessage = "ERROR: " & Err.number & ": " & Err.Description
        Err.Clear
    End If
    If d = 0 Then d = Time
    With Application.WorksheetFunction
        timeStamp = .Text(Hour(d), "00") & ":" & .Text(Minute(d), "00") & ":" & .Text(Second(d), "00") & ":" & .rept(Chr(9), Indent)
    End With
    If Len(Caller) <> 0 Then timeStamp = timeStamp & Chr(9) & Caller
    If Len(Context) <> 0 Then timeStamp = timeStamp & ": " & Chr(9) & Context
    If Len(message) <> 0 Then timeStamp = timeStamp & ": " & Chr(9) & message
    Select Case newLine
    Case Before
        timeStamp = Chr(10) & timeStamp
    Case After
        timeStamp = timeStamp & Chr(10)
    Case Both
        timeStamp = Chr(10) & timeStamp & Chr(10)
    Case Else
    End Select
    If Len(errorMessage) <> 0 Then
        timeStamp = timeStamp & Chr(9) & errorMessage
    End If

End Function

您可以为每个模块分配模块级缩进，以组织层次结构，使其易于理解

如果需要，在每个子项、函数或属性中

sub mySubName()
Const cMyName As String = "mySubName"

If debugEvents Then Debug.Print timeStamp(NewLine:=Before,Indent:=cModuleIndent, Caller:=cModuleName, Context:=cMyName, Message:="Start")

'Do stuff

If debugEvents Then Debug.Print timeStamp(NewLine:=After,Indent:=cModuleIndent, Caller:=cModuleName, Context:=cMyName, Message:="End")
End Sub

…或者您可以使用Me.Name作为上下文（如果是表单或工作表等），并且您可以在消息中放入您喜欢的任何消息或变量值

您还可以使用计时器（如MicroTimer）并将结果放入消息部分

以下是一个示例输出：

15:54:07:       Roll-Up Select:     Worksheet_Activate:      Start: 3.24591834214516E-03


15:54:07:           cDataViewSheet:     Class_Initialize:   Start

15:54:07:               cRevealTarget:  Class_Initialize:   START
15:54:07:               cRevealTarget:  Class_Initialize:   END

15:54:09:           cDataViewSheet:     startTimer:     : START
15:54:09:           cDataViewSheet:     startTimer:     init Timer
15:54:09:               cOnTime:    Class_Initialize
15:54:09:               cOnTime:    Let PulseTime:  Inheret PulseTime from host sheet
15:54:09:           cDataViewSheet:     startTimer:     : END

15:54:09:       Roll-Up Select:     Worksheet_Activate:      END:   1.38736216780671

---

到派对有点晚了，但代码重复的问题可以在类似的情况下在这里显示出来。删除第一行代码，任何错误消息都会抛出两次。这是因为清除组合框的行被视为一个更改，并拾取另一个错误，因为null输入是一个错误！可能会对有类似问题的人有所帮助。

尝试删除Dim e=Application.EnableEvents并用Application.EnableEvents=True替换Application.EnableEvents=e。重新运行代码。它仍然运行两次吗？如果它真的命中了End Sub，那么您的TempComboS\u更改将从代码的另一部分调用两次。调试并逐步完成调用代码。应该能够知道第二个电话是从哪里打来的。您还可以通过删除此子系统中的所有代码来验证这一点，只需插入一个msgbox，查看它是否被调用两次。BK201:是的，它仍然运行两次。事实上，如果中途停止执行，它会立即重新启动。波特兰：没有呼叫代码。对于这个测试，我要么通过更改组合框，要么通过在IDE窗口中运行该过程来运行它。还有一件奇怪的事情：我插入了一行TempComboS.Visible=False来隐藏组合框，但它不起作用。不管它为什么触发两次，Application.EnableEvents不适用于userform控件。正如您在我的代码段中所看到的，更改事件中没有影响组合框的代码。事实上，当更改事件中根本没有代码时，它会运行两次。如果可能的话，我想看看您的工作簿？如果是的话，那么你能在www.wikisend.com上传同样的内容并在这里共享链接吗？我不确定我是否能获得发送整个工作簿的权限。我不认为有什么特别的东西可以展示给你？如果你确定这段代码总是会触发两次，你可以通过使用Static关键字来声明sub中的boolRunance来改进这段代码

Public Enum eNewLine
    No
    Before
    After
    Both
End Enum

Public Function timeStamp(Optional d As Double = 0, Optional newLine As eNewLine = No, Optional Indent As Long = 0, _
                            Optional Caller As String, Optional Context As String, Optional message As String) As String
Dim errorMessage As String

    If Err.number <> 0 Then
        errorMessage = "ERROR: " & Err.number & ": " & Err.Description
        Err.Clear
    End If
    If d = 0 Then d = Time
    With Application.WorksheetFunction
        timeStamp = .Text(Hour(d), "00") & ":" & .Text(Minute(d), "00") & ":" & .Text(Second(d), "00") & ":" & .rept(Chr(9), Indent)
    End With
    If Len(Caller) <> 0 Then timeStamp = timeStamp & Chr(9) & Caller
    If Len(Context) <> 0 Then timeStamp = timeStamp & ": " & Chr(9) & Context
    If Len(message) <> 0 Then timeStamp = timeStamp & ": " & Chr(9) & message
    Select Case newLine
    Case Before
        timeStamp = Chr(10) & timeStamp
    Case After
        timeStamp = timeStamp & Chr(10)
    Case Both
        timeStamp = Chr(10) & timeStamp & Chr(10)
    Case Else
    End Select
    If Len(errorMessage) <> 0 Then
        timeStamp = timeStamp & Chr(9) & errorMessage
    End If

End Function

'Module level Trace Hearder
Const debugEvents as Boolean = True
Const cModuleName As String = "myModuleName"
Const cModuleIndent As Long = 1

sub mySubName()
Const cMyName As String = "mySubName"

If debugEvents Then Debug.Print timeStamp(NewLine:=Before,Indent:=cModuleIndent, Caller:=cModuleName, Context:=cMyName, Message:="Start")

'Do stuff

If debugEvents Then Debug.Print timeStamp(NewLine:=After,Indent:=cModuleIndent, Caller:=cModuleName, Context:=cMyName, Message:="End")
End Sub

15:54:07:       Roll-Up Select:     Worksheet_Activate:      Start: 3.24591834214516E-03


15:54:07:           cDataViewSheet:     Class_Initialize:   Start

15:54:07:               cRevealTarget:  Class_Initialize:   START
15:54:07:               cRevealTarget:  Class_Initialize:   END

15:54:09:           cDataViewSheet:     startTimer:     : START
15:54:09:           cDataViewSheet:     startTimer:     init Timer
15:54:09:               cOnTime:    Class_Initialize
15:54:09:               cOnTime:    Let PulseTime:  Inheret PulseTime from host sheet
15:54:09:           cDataViewSheet:     startTimer:     : END

15:54:09:       Roll-Up Select:     Worksheet_Activate:      END:   1.38736216780671

Private Sub cmbOrder_Change()
    If cmbOrder = "" Then Exit Sub

    Dim arr As Variant, maxorder As Integer
    arr = Range("rngOrder")
    maxorder = WorksheetFunction.Max(arr)
    Dim errmsg As String, err As Boolean
    err = False
    errmsg = "This value must be a whole number between 1 and " & maxorder + 1
    Dim v As Variant
    v = cmbOrder.Value
    If IsNumeric(v) = False Or (IsNumeric(v) = True And (v > maxorder + 1) Or v < 1) 
    Then
        MsgBox errmsg
        cmbOrder = ""
        err = False
    Else
        txtOrder.Value = cmbOrder.Value
    End If

End Sub