过长的程序
这是我的代码的一部分：
Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range(Cells(7, Target.Column), Cells(505, Target.Column))) Is Nothing Then Exit Sub If Target.Cells.Count > 1 Then Exit Sub If WorksheetFunction.CountIf(Range(Cells(7, Target.Column), Cells(505, Target.Column)), Target) > 1 Then Application.EnableEvents = False Application.Undo Application.EnableEvents = True MsgBox "DUBLICATED PLEASE DEFINE ANOTHER!" End If If Not Intersect(Target, Range("H7")) Is Nothing Then Range("K7").ClearContents If Not Intersect(Target, Range("H8")) Is Nothing Then Range("K8").ClearContents If Not Intersect(Target, Range("H9")) Is Nothing Then Range("K9").ClearContents If Not Intersect(Target, Range("H10")) Is Nothing Then Range("K10").ClearContents If Not Intersect(Target, Range("H11")) Is Nothing Then Range("K11").ClearContents If Not Intersect(Target, Range("H12")) Is Nothing Then Range("K12").ClearContents If Not Intersect(Target, Range("H13")) Is Nothing Then Range("K13").ClearContents If Not Intersect(Target, Range("H14")) Is Nothing Then Range("K14").ClearContents If Not Intersect(Target, Range("H15")) Is Nothing Then Range("K15").ClearContents If Not Intersect(Target, Range("H16")) Is Nothing Then Range("K16").ClearContents If Not Intersect(Target, Range("H17")) Is Nothing Then Range("K17").ClearContents If Not Intersect(Target, Range("H18")) Is Nothing Then Range("K18").ClearContents 'Next 500 rows End Sub 代码继续向下500行，并检查每行甚至50行的工作，但500行的“程序太长”的错误
这是一种缩短程序再次错误代码的方法吗？
编辑 （从下面的评论）
一些单元格被合并，并且下面粘贴的被更改的代码已经testing了错误“不能改变合并单元的一部分”（G：J）：
If Not Intersect(Target, Range("H7:J55")) Is Nothing Then Cells(Target.Row, "K").ClearContents If Not Intersect(Target, Range("T11:T17")) Is Nothing Then Cells(Target.Row, "U").ClearContents If Not Intersect(Target, Range("E61:E109")) Is Nothing Then Cells(Target.Row, "G:J").ClearContents Application.EnableEvents = True
如果没有看到其他〜470行的代码，就不可能捕捉到所有的条件（而TBH则需要完全重写事件处理程序），但总的来说，你会想通过查看对于你正在重复的条件，然后只针对不同的代码进行编码。 例如，在这些代码行中…
If Not Intersect(Target, Range("H7")) Is Nothing Then Range("K7").ClearContents If Not Intersect(Target, Range("H8")) Is Nothing Then Range("K8").ClearContents If Not Intersect(Target, Range("H9")) Is Nothing Then Range("K9").ClearContents If Not Intersect(Target, Range("H10")) Is Nothing Then Range("K10").ClearContents 'Etc...
…唯一改变的是行号。 其他一切都是一样的。 所以testing并更改列 – 所有这些都是一样的：
If Target.Column = 8 Then Cells(Target.Row, 11).ClearContents End If
请注意，这是如何隔离相似性的，只适用于差异。 请记住，这不会是一个“复制从粘贴到VBE”的解决scheme – 您需要根据您对有关合并单元格的注释添加其他约束条件。
对于单个单元也没有理由使用Intersect 。 testingRow和Column更有效，更易于阅读。 Range("H7")将与单个单元格相交的唯一方法是该单元格是"H7" 。
您也可以在上面的If语句中将相同的逻辑应用于此过程顶部的guard子句：
If Intersect(Target, Range(Cells(7, Target.Column), Cells(505, Target.Column))) Is Nothing Then Exit Sub If Target.Cells.Count > 1 Then Exit Sub
第一次检查testing是否在7到505之间 – 就是这样。 第二个约束是仅对单个单元格进行操作。 作为一个方面说明这是一个错误，因为它忽略了这样一个事实，即用户可以通过删除或粘贴多个单元来绕过所有的validation – 在重新编写剩余的单元之后，您需要解决这个问题。 如果您颠倒了顺序，您可以简单地testing.Row像这样：
If Target.Cells.Count > 1 Then Exit Sub If Target.Row < 7 Or Target.Row > 505 Then Exit Sub
从你的评论中的代码，这是一个错误：
Cells(Target.Row, "G:J").ClearContents
Cells需要单列 。 传递“G：J”将出现错误1004.如果需要在多列上操作，则必须使用Range ：
Range(Cells(Target.Row, 7), Cells(Target.Row, 10)).ClearContents
我从关于合并单元格的评论中猜测，无论如何您都不需要在该特定情况下操作Range 。 如果合并单元格，则需要使用合并范围中的左上angular单元格。 例如，如果“G10：J10”是单元格的合并范围，并且Target.Row为10，则可以使用以下命令清除它：
Cells(Target.Row, 7).ClearContents
不要以为500行可能会导致这个错误，但是你可以用这个replace第二个位
If Not Intersect(Target, Range("H7:H18")) Is Nothing Then Target.Offset(, 3).ClearContents
中间部分：
- 需要在最后的testing中包装
Application.EnableEvents = False - 您的最后一个testing应该是
If Not Intersect(Target, Range("H7:H505")) Is Nothing Then Cells(Target.Row, "K").ClearContents
新的部分
Application.EnableEvents = False If WorksheetFunction.CountIf(Range(Cells(7, Target.Column), Cells(505, Target.Column)), Target) > 1 Then Application.Undo MsgBox "DUPLICATED PLEASE DEFINE ANOTHER!" End If If Not Intersect(Target, Range("H7:H505")) Is Nothing Then Cells(Target.Row, "K").ClearContents Application.EnableEvents = True