工作表更改重复步骤

我已经重新修改了这个macros两天的负载不同的方式来试图防止重复的步骤，但范围G2步似乎运行3或4次和范围G3 2或3次。 有没有人有任何想法？

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Target.Worksheet.Range("G2")) Is Nothing Then Range("g4").Value = "Team" Range("g3").Value = "Division" Call check Exit Sub End If If Not Intersect(Target, Target.Worksheet.Range("G3")) Is Nothing Then Range("G4").Value = "Team" Call check Exit Sub End If If Not Intersect(Target, Target.Worksheet.Range("G4")) Is Nothing Then Call check Exit Sub End If If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then Call check Exit Sub End If End Sub 

Answer 1

您的Worksheet_Change已经屈服于事件驱动的工作表/工作簿子过程中最常见的三个错误。

• 在对工作表进行修改时，您不会禁用事件。 每个更改都会触发另一个事件，Worksheet_Change尝试一遍又一遍地运行，直到崩溃。
• 目标可以是单个细胞或多个细胞。 你需要通过使用Intersect来处理目标是多个单元格的可能性，以便在你的可能范围内获得受影响的单元格。
• 如果您因任何原因而禁用事件，请务必提供错误控制，如果一切顺利，则将其重新打开。 通常，这可以在退出Worksheet_Change之前完成，但是如果要使用Exit Sub则不会。

这是我的程序版本。

 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("D4, G2:G4")) Is Nothing Then On Error GoTo Safe_Exit Application.EnableEvents = False Dim trgt As Range For Each trgt In Intersect(Target, Range("D4, G2:G4")) Select Case trgt.Address(0, 0) Case "G2" Range("G3:G4") = Application.Transpose(Array("Division", "Team")) 'call check is below Case "G3" Range("G4") = "Team" 'call check is below Case "D4", "G4" 'call check is below End Select Next trgt Call check End If Safe_Exit: Application.EnableEvents = True End Sub 

Answer 2

您的代码位于Worksheet_Change 事件中 。 每次更改工作表时，都会触发该事件，包括代码更改时

 Range("g4").Value = "Team" 

因此，你陷入了一个潜在的无限循环。 在进行任何更改之前要避免这种禁用事件

 Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False ' this turns events off If Not Intersect(Target, Target.Worksheet.Range("G2")) Is Nothing Then Range("g4").Value = "Team" Range("g3").Value = "Division" Call check Application.EnableEvents = True Exit Sub End If If Not Intersect(Target, Target.Worksheet.Range("G3")) Is Nothing Then Range("G4").Value = "Team" Call check Application.EnableEvents = True Exit Sub End If If Not Intersect(Target, Target.Worksheet.Range("G4")) Is Nothing Then Call check Application.EnableEvents = True Exit Sub End If If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then Call check Application.EnableEvents = True Exit Sub End If Application.EnableEvents = True End Sub 

您可能需要启用或禁用您正在调用的潜艇内的事件。

顺便说一句，我会检查你是否真的需要这些退出子，如果不是，你可以只在开始时禁用一次事件，并在最后再次重新启用。