单击VBA Excel代码运行多次运行

Question

我逐步浏览了我的代码，似乎我的点击子例程每次鼠标点击都运行了不止一次。我通过在“Private Sub”行上休息来调试它。在功能上，它做了它应该做的，但我希望它只运行一次。我似乎无法看到我所缺少的东西，但它几乎看起来像一个未闭合的循环？我只是不确定，因为子程序本身没有循环。

Private Sub CreateActuals_Click()
'Function that creates actual prices based on the today's date

'Declare variables
Dim startRow As Integer
Dim lastRow As Long
Dim quoteFromDate As Date
Dim delFromDate As Date
Dim delToDate As Date
Dim todayDate As Date
Dim actual As String

'Initialize variables
startRow = 3

'Finds the row index of last used row in the active sheet
lastRow = Range("A" & Rows.Count).End(xlUp).Row

'Checks each row for the date logic and paste those that pass
Dim i As Integer

For i = startRow To lastRow
    todayDate = Date
    quoteFromDate = DateValue(Cells(i, 2))
    delFromDate = DateValue(Cells(i, 4))
    delToDate = DateValue(Cells(i, 5))
    actual = Cells(i, 7)

    If quoteFromDate <= todayDate And quoteFromDate <= delToDate And quoteFromDate >= delFromDate And actual = "F" Then
        With ActiveSheet
            .Cells(i, 15).Formula = .Cells(i, 1).Formula
            .Range(Cells(i, 18), Cells(i, 20)).Formula = .Range(Cells(i, 4), Cells(i, 7)).Formula
            .Cells(i, 16).Value = DateValue(quoteFromDate) & " " & TimeValue("6:00:00 PM")
            .Cells(i, 17).Value = DateAdd("d", 1, quoteFromDate) & " " & TimeValue("5:59:59 PM")
            .Cells(i, 21).Value = "A"
        End With
    End If
Next i


'Copy only non-duplicates back to main
Dim mainArr As Variant
mainArr = Range("A" & startRow & ":G" & Range("A" & Rows.Count).End(xlUp).Row)

Dim tempArr As Variant
tempArr = Range("O" & startRow & ":U" & Range("O" & Rows.Count).End(xlUp).Row)

Dim j As Integer, k As Integer, match As Boolean

'MsgBox DateValue(mainArr(1, 2)) & "=" & DateValue(tempArr(1, 2))
'MsgBox DateValue(mainArr(121, 3)) & "=" & DateValue(tempArr(1, 3))

For j = LBound(tempArr) To UBound(tempArr)
    For k = LBound(mainArr) To UBound(mainArr)
        match = False
        If mainArr(k, 1) = tempArr(j, 1) _
       And DateValue(mainArr(k, 2)) = DateValue(tempArr(j, 2)) _
       And DateValue(mainArr(k, 3)) = DateValue(tempArr(j, 3)) _
       And DateValue(mainArr(k, 4)) = DateValue(tempArr(j, 4)) _
       And DateValue(mainArr(k, 5)) = DateValue(tempArr(j, 5)) _
       And mainArr(k, 6) = tempArr(j, 6) _
       And mainArr(k, 7) = tempArr(j, 7) _
    Then
        match = True
        Exit For
    End If
Next j
'Clear unused records

Range(Cells(startRow, 15), Cells(Range("O" & Rows.Count).End(xlUp).Row, 21)).ClearContents

End Sub

起始文件的片段（此数据由用户从工作簿中的其他工作表维护）

为所提供的屏幕截图点击“创建实际值”按钮后的结果：