检查更改事件时的运行时错误424

问题描述:

我创建了一个程序,该程序在列A或列I中查找要更改的项目。如果列I发生更改,则会删除该行并将其移至新工作表。如果列A发生更改,则应对所有数据进行排序。但是,当调用第二个Application.Intersect(KeyCells2, Range(Target.Address))时,它错误地告诉我我有一个运行时错误424.为什么会发生这种情况?它似乎有一个关键单元格范围和一个target.address。检查更改事件时的运行时错误424

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim KeyCells As Range 
    Dim KeyCells2 As Range 
    Dim LastRowCompleted As Long 
    Dim RowToDelete As Long 
    Dim CurCell As String 
    RowToDelete = 0 
    LastRow = Sheets("Current").Cells(Sheets("Current").Rows.Count, "A").End(xlUp).Row 
    LastRowCompleted = Sheets("completed").Cells(Sheets("completed").Rows.Count, "A").End(xlUp).Row 
    LastRowCompleted = LastRowCompleted + 1 'Next row after last row 
    Set KeyCells = Range("I3:I16384") 
    Set KeyCells2 = Range("A3:A16384") 
    CurCell = ActiveCell.Address 

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then 
     Application.EnableEvents = False 

     'Cut and Paste Row 
     Target.EntireRow.Copy Sheets("completed").Range(LastRowCompleted & ":" & LastRowCompleted) 
     'Mark to delete row 
     RowToDelete = Target.EntireRow.Row 

     Call DeleteRow(RowToDelete) 

    Application.EnableEvents = True 

    End If 

    Range(CurCell).Select 

    If Not Application.Intersect(KeyCells2, Range(Target.Address)) Is Nothing Then 
     Application.EnableEvents = False 

       'Sort 
MsgBox "lastrow completed: " & LastRow 
     Range("A3:Z" & LastRow).Select 
    ActiveWorkbook.Worksheets("current").Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets("current").Sort.SortFields.Add Key:=Range("A3:A" & LastRow) _ 
     , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
    ActiveWorkbook.Worksheets("current").Sort.SortFields.Add Key:=Range("B3:B" & LastRow) _ 
     , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
    ActiveWorkbook.Worksheets("current").Sort.SortFields.Add Key:=Range("E3:E" & LastRow) _ 
     , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
    With ActiveWorkbook.Worksheets("current").Sort 
     .SetRange Range("A3:J" & LastRow) 
     .Header = xlGuess 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

    Range(CurCell).Select 

    Application.EnableEvents = True 

    End If 

End Sub 

Sub DeleteRow(Row As Long) 
    If Row > 0 Then 
     Rows(Row).EntireRow.Delete Shift:=xlUp 
    End If 
End Sub 
+0

尝试'如果不是相交(KeyCells2,Target)是Nothing Then',此外,您可以将'行(行).EntireRow.Delete Shift:= xlUp'更改为'行(行)。删除Shift:= xlUp' –

+0

@ShaiRado似乎没有帮助。我仍然得到相同的错误。我有一种感觉'Range(Target.Address)'没有得到值是应该如何。 – Brad

+0

您不需要使用'Range(Target.Address)',因为'Target'已被定义为'Range' –

如果删除第If块的行然后Target不再存在,所以你不能在你的第二个If块使用它。

作为修复,您可以在删除该行后退出Sub。

P.S. - 如果你试图编辑数据,“自动排序”似乎会非常恼人......