#VBA Private Sub Worksheet_Change

Question

Может ли какая-нибудь добрая душа помочь мне, я потратил значительное количество времени на поиски и попытки заставить эти 2 куска кода работать, но не смог.

Можно ли как-нибудь объединить эти 2 фрагмента? Они служат двум различным целям.

1

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Len(Target) = 10 Then
        Range("I" & Target.Row & ":J" & Target.Row & ", K" & Target.Row & ", M" & Target.Row) = "N"
    End If
End Sub

2.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 12 And Target.Value = "Y" Then
        Target.Offset(0, 1) = Date
    End If
End Sub

Я в растерянности ....

Answer 1

Вы можете использовать код ниже.
Отключите события, чтобы остановить запуск события изменения при обновлении значений в столбцах I:K & N.

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo ERR_HANDLE

    Application.EnableEvents = False

    With Target

        If .Column = 12 Then
            If .Value = "Y" Then
                .Offset(, 1) = Date
            End If
        ElseIf .Column = 1 Then
            If Len(.Value) = 10 Then
                Cells(.Row, 9).Resize(, 3) = "N" 'Column I:K
                Cells(.Row, 13) = "N" 'Column M
            End If
        End If

    End With

EXIT_PROC:

    Application.EnableEvents = True
    On Error GoTo 0

Exit Sub

ERR_HANDLE:
    Select Case Err.Number
        Case 13 'Type mismatch.
            Resume EXIT_PROC
        Case Else 'Any unhandled errors.
            MsgBox "Error " & Err.Number & vbCr & _
                Err.Description, vbOKOnly, "Error in " & ThisWorkbook.Name
            Resume EXIT_PROC
    End Select
End Sub

Редактировать после принятия:
Я добавил обработчик ошибок в код по предложению @MathieuGuindon. После устранения ошибки код возвращается к метке EXIT_PROC, поэтому в процедуре есть только одна точка выхода.

Answer 2

Вы можете попробовать это как комбинированный метод:

Вам нужно отключить оповещения при внесении изменений, когда у вас загружено событие worksheet_change в макросе, иначе вы можете оказаться в бесконечном цикле.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Or Target.Column <> 12 Then Exit Sub

    If Len(Target) = 10 Then
        Application.EnableEvents = False
            Range(Cells(Target.Row, "I"), Cells(Target.Row, "K")) = "N"
            Range("M" & Target.Row) = "N"
        Application.EnableEvents = True
    End If

    If Target.Column = 12 And Target.Value = "Y" Then
        Application.EnableEvents = False
            Target.Offset(0, 1) = Date
        Application.EnableEvents = True
    End If

End Sub