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

时间:2017-07-19 15:35:42

标签: vba excel-vba excel

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

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

1 个答案:

答案 0 :(得分:1)

如果您删除了第一个If块中的行,则Target不再存在,因此您无法在第二个If块中使用它。

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

P.S。 - 那"自动排序"如果您正在尝试编辑数据,似乎会非常烦人......