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

Question

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

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

空白行是有用代码所在的位置；就目前而言，它显然没有做任何事情。但是，当我以这种方式运行它（使用空白行）时，它会到达“End Sub”，然后它会回到开头并再次运行。 （这会使有用的代码运行两次）。

为什么会这样？

编辑：为那些一直在帮助我的人澄清一下。

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

Private Sub TempComboS_Change()
End Sub

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

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

我将尝试“运行一次”建议，如果可行，我会通知您。

---

我尝试了您建议的“运行一次”代码。它排序的作品，但我似乎有一个更大的问题。当我从数据验证单元格中选择下拉列表时，会触发 TempComboS_Change 事件——但我不仅没有触摸此组合框，而且该单元格不是组合框的 LinkedCell。换句话说，它似乎是由 unconnected 到组合框的操作触发的！

必须找出关于调用堆栈的事情......

Answer 1

这里有一些代码可以帮助调查“事件顺序”问题

在标准模块中

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 或 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

Answer 2

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

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

Answer 3

只要组合框发生变化，Combobox_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

因此，如果您加载用户表单并选择一个项目 ComboBox1_Change 将触发。然后，您使用命令按钮清除组合，ComboBox1_Change 将再次触发。

还有另一种情况，更改将再次触发。当您 change 时，来自 ComboBox1_Change 事件本身的组合框。这是一个例子。我believe这就是你的情况。

场景 1

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

Private Sub ComboBox1_Change()
    MsgBox "A"
    ComboBox1.Clear
End Sub

场景 2

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

Private Sub ComboBox1_Change()
    MsgBox "A"
    ComboBox1.ListIndex = 1
End Sub

在第一种情况下你可以逃跑

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

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

在第二个场景中，你可以使用这样的东西

Dim boolRunOnce As Boolean

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

Private Sub ComboBox1_Change()
    If boolRunOnce = False Then
        MsgBox "A"
        boolRunOnce = True
        ComboBox1.ListIndex = 1
    Else
        boolRunOnce = False
    End If
End Sub