Excel "вставить строку", вызывая ошибку с target.offset - PullRequest
0 голосов
/ 11 июня 2019

Привет команда, у меня есть этот простой фрагмент кода, который автоматизирует некоторые даты и прочее при добавлении позиций на лист. это работает хорошо, но когда я вставляю строку в таблицу [щелкните правой кнопкой мыши имя строки> вставить], возникает ошибка.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    Dim plusWeek
    plusWeek = Now() + 7

For Each cell In Target
    '========adds closed date, deleted date if status degenerates=========
    If cell.Column = 13 And cell = "Closed" Then
        Target.Offset(0, -2) = Format(Now(), "yyyy-mm-dd")
    End If
    If cell.Column = 13 And cell = "In-Progress" Then
        Target.Offset(0, -2) = ""
    End If
    If cell.Column = 13 And cell = "Open" Then
        Target.Offset(0, -2) = ""
    End If

    '========adds date added if date is embty and description is not empty========
    If cell.Column = 8 And IsEmpty(Target.Offset(0, 1)) And Not IsEmpty(Target.Offset(0, 0)) Then
        Target.Offset(0, 1) = Format(Now(), "yyyy-mm-dd")
        Target.Offset(0, 2) = Format(plusWeek, "yyyy-mm-dd")
        Target.Offset(0, 5) = "Open"
    End If
    '========deletes date added if description is empty========
    'If cell.Column = 8 And IsEmpty(Target.Offset(0, 0)) Then
    '    Target.Offset(0, 1) = ""
    'End If

Next cell
End Sub

Если я вставляю строку, добавляю строку или удаляю строку, возникает ошибка 1004. отладчик выделяет эту строку, но я не могу понять, откуда возникла ошибка.

 If cell.Column = 8 And IsEmpty(Target.Offset(0, 1)) And Not 
 IsEmpty(Target.Offset(0, 0)) Then

Буду признателен за любую помощь. С уважением, Jono

1 Ответ

1 голос
/ 11 июня 2019

Примерно так должно работать:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim cell As Range, rng As Range
    Dim plusWeek
    plusWeek = Now() + 7

    Set rng = Application.Intersect(Target, Me.Range("H:H,M:M"))
    If rng Is Nothing Then Exit Sub

    On Error GoTo haveError           '<< make sure events don't get left turned off

    Application.EnableEvents = False  '<< turn events off
    For Each cell In rng.Cells
        '========adds closed date, deleted date if status degenerates=========
        If cell.Column = 13 Then
            Select Case cell.Value
                Case "Closed": cell.Offset(0, -2) = Format(Now(), "yyyy-mm-dd")
                Case "In-Progress", "Open": cell.Offset(0, -2) = ""
            End Select
        End If

        '========adds date added if date is embty and description is not empty========
        If cell.Column = 8 And IsEmpty(cell.Offset(0, 1)) And Not IsEmpty(cell) Then
            cell.Offset(0, 1) = Format(Now(), "yyyy-mm-dd")
            cell.Offset(0, 2) = Format(plusWeek, "yyyy-mm-dd")
            cell.Offset(0, 5) = "Open"
        End If
        '========deletes date added if description is empty========
        'If cell.Column = 8 And IsEmpty(Target.Offset(0, 0)) Then
        '    Target.Offset(0, 1) = ""
        'End If

    Next cell

haveError:
    Application.EnableEvents = True

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...