太长的程序

时间:2017-02-25 09:55:04

标签: excel excel-vba vba

以下是我的代码部分:

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行提供“过程太长”的错误

这是一种在错误代码中再次缩短程序的方法吗?

编辑(来自以下评论)

某些单元格已合并,下面粘贴的已更改代码已经过测试,错误为“无法更改合并单元格的一部分”(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

3 个答案:

答案 0 :(得分:0)

不要认为500行可能会导致该错误,但您可以用此

替换第二位
private boolean haveInternet()
{
     ConnectivityManager connectivityManager = (ConnectivityManager) getSystemService(Context.CONNECTIVITY_SERVICE);
     NetworkInfo activeNetworkInfo = connectivityManager.getActiveNetworkInfo();
    return activeNetworkInfo != null && activeNetworkInfo.isConnected();
}

答案 1 :(得分:0)

中间到结尾部分:

  • 还需要将Application.EnableEvents = False包裹在最后一次测试中
  • 您的上一次测试应为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

答案 2 :(得分:0)

如果没有看到其他〜470行代码,就无法捕捉到所有条件(而且TBH你还需要完全重写事件处理程序),但总的来说你是&#39 ; ll想要通过查找您正在重复的条件来解决此类问题,然后针对仅针对不同的进行编码。例如,在这些代码行中......

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

......唯一改变的是行号。其他一切都是一样的。因此,测试并更改 - 所有这些都是相同的:

If Target.Column = 8 Then
    Cells(Target.Row, 11).ClearContents
End If

注意如何隔离相似性并仅与差异一起使用。请记住,这不是来自SO的复制,粘贴到VBE"解决方案 - 您需要根据您对合并单元格的评论添加其他约束。

也没有理由对单个细胞使用Intersect。测试RowColumn的效率要高得多,也更容易阅读。 Range("H7")与单个单元格相交的唯一方法是该单元格是"H7"

您也可以在上面的If语句中将相同类型的逻辑应用于此处过程顶部的保护条款:

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

第一次检查测试该行是否在7到505之间 - 那就是它。第二个约束是仅对单个单元进行操作。另请注意,这是一个错误,因为它忽略了用户可以通过删除或粘贴多个单元格来绕过 所有验证 的事实 - 您需要在重新编写其余部分之后解决这个问题。如果你颠倒了订单,你可以像这样测试.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需要单个列。传递&#34; G:J&#34;将是错误1004.如果您需要对多个列进行操作,则必须使用Range

Range(Cells(Target.Row, 7), Cells(Target.Row, 10)).ClearContents

我猜测有关合并单元格的评论无论如何都不需要在该特定情况下操作Range。如果合并单元格,则需要使用合并范围中的左上角单元格。例如,如果&#34; G10:J10&#34;是一个合并的单元格区域,Target.Row是10,你可以用以下方法清除它:

Cells(Target.Row, 7).ClearContents