SpecialCells在Excel 2010中导致SheetSelectionChange事件

我有一个testingmacros

Sub test() Dim rSrcMatrix As Range Set rSrcMatrix = Sheets("Code Matrix").Range("Xfer_To_Xfer_Matrix").Range("A1") Set rSrcMatrix = rSrcMatrix.Resize(rSrcMatrix.SpecialCells(xlCellTypeLastCell).Row, rSrcMatrix.SpecialCells(xlCellTypeLastCell).Column) End Sub 

我正在使用这个macros来testing我在VS2010中创build的COM插件。 我已经委托SheetSelectionChange到一些函数的SheetSelectionChange事件。

现在我注意到，每当我运行这个macros，Excel会触发SheetSelectionChange事件4次，我的插件会多次调用关联的方法。

有什么我失踪或这是一个Excel中的错误？

Answer 1

我相信，我可能是错的，因为我找不到一个MSDN文章来certificate它，但SpecialCells执行一种select和触发Worksheet_SelectionChange或Workbook_SheetSelectionChange事件，因此你需要closures事件。

这是一个简单的方法来testing它。

将此代码放置在“工作表代码区”中

 Private Sub Worksheet_SelectionChange(ByVal Target As Range) MsgBox "Damn! The SpecialCells caused me to pop up!!!" End Sub Sub test() Debug.Print ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row End Sub 

Worksheet_SelectionChange和Workbook_SheetSelectionChange执行相同的工作。 Worksheet_SelectionChange在表单代码中用于特定工作表。 而当您希望事件触发该工作簿中的所有工作表时，将使用Workbook_SheetSelectionChange 。

您从评论中得到的问题 ：如果我们想要将另一个事件与该代码行相关联，该怎么办？ 在这种情况下，我们不能压制这个事件。

现在，我们有两个select。 根据你上面的问题，我们不能使用Alternative One 。 所以你可以直接跳到Alternative 2

替代scheme1

closures事件

 Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error GoTo Whoa Application.EnableEvents = False ' '~~> YOUR CODE ' Letscontinue: Application.EnableEvents = True Exit Sub Whoa: MsgBox Err.Description Resume Letscontinue End Sub 

替代scheme2

而不是使用SpecialCells来查找最后一行或最后一列，我们将使用.Find 。

 Sub test() Dim ws As Worksheet Dim rSrcMatrix As Range Dim Lrow As Long, LCol As Long Set ws = ThisWorkbook.Sheets("Code Matrix") With ws If Application.WorksheetFunction.CountA(.Cells) <> 0 Then Lrow = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row LCol = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column Else Lrow = 1 End If Set rSrcMatrix = .Range("Xfer_To_Xfer_Matrix").Range("A1") Set rSrcMatrix = rSrcMatrix.Resize(Lrow, LCol) Debug.Print rSrcMatrix.Address End With End Sub