VBA Workshhet Change - ограничение изменений только для определенного диапазона

Question

У меня есть триггер, который я хочу использовать на определенном листе - только внутри двух определенных столбцов.Но когда я вписываю значение в другой диапазон, это вызывает частную подпункт этой таблицы.Я хочу, чтобы он начал работать только тогда, когда я могу изменить значение в столбцах E или H. Кто-то знает, как это сделать правильно?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim LR As Long
Dim rng1 As Range
Dim rng2 As Range

'WE WANT TO KEEP THE TARGET COLUMNS BETWEEN 0% TO 100%
LR = Cells(Rows.Count, "A").End(xlUp).Row

Set rng1 = Intersect(Target, Range(Cells(2, "E"), Cells(LR, "E")))

On Error GoTo 1
If Target.Value < 0 Or Target.Value > 1 Then
    MsgBox "bla bla bla", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight, "error"
    Target.Value = 0
    Exit Sub
End If

On Error GoTo 1
Set rng2 = Intersect(Target, Range(Cells(2, "H"), Cells(LR, "H")))
If Target.Value < 0 Or Target.Value > 1 Then
    MsgBox "bla bla bla", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight, "error"
    Target.Value = 0
    Exit Sub
End If


1
End Sub

Answer 1

Пересечение может проверить, пересекаются ли какие-либо ячейки в Target (да, Target может быть больше, чем одна ячейка) с объединением столбцов E и H.

Private Sub Worksheet_Change(ByVal Target As Range)

    ' this next line could also be,
    'If Not Intersect(Target, Range("E:E, H:H")) Is Nothing Then
    If Not Intersect(Target, Union(Range("E:E"), Range("H:H"))) Is Nothing Then
        On Error GoTo bye_bye
        Application.EnableEvents = False
        Dim t As Range
        For Each t In Intersect(Target, Union(Range("E:E"), Range("H:H")))
            If (t.Value2 < 0 Or t.Value2 > 1) And t.Row > 1 Then
                MsgBox "bla bla bla", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight, "error"
                t = 0
            End If
        Next t
    End If

bye_bye:
    Application.EnableEvents = True
End Sub

Answer 2

Вам просто нужно проверить, пересекается ли Target с желаемым диапазоном.В этой проверке я бы объединил два столбца вместе.

Как загадочно указано в DisplayName, поскольку Target может содержать более одной ячейки, вам следует проверять каждую ячейку в цели по отдельности.В качестве альтернативы, если ваше намерение для Target состояло в том, чтобы всегда иметь одну ячейку, вы можете вообще избежать оператора For...Each и использовать эту проверку: If Target.Cells.Count > 1 Then Exit Sub, чтобы не запускать процедуру при изменении более 1 ячейки.

Я также добавил еще одну цель пересечения, Me.Rows("2:" & rows.count), чтобы избежать обновления любых заголовков, которые у вас могут быть.Если ваши данные не содержат заголовков, вы можете удалить этот диапазон из Intersect().

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo safeExit

    Dim rngIntersect As Range
    Set rngIntersect = Intersect(Target, Union(Me.Columns("E"), Me.Columns("H")), _
                                                        Me.Rows("2:" & Rows.Count))

    If Not rngIntersect Is Nothing Then

        Application.EnableEvents = False

        Dim cel As Range
        For Each cel In rngIntersect
            If cel.Value < 0 Or cel.Value > 1 Then
                MsgBox "bla bla bla", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight, _
                                                                                "error"
                cel.Value = 0
            End If
        Next cel

    End If

safeExit:

    Application.EnableEvents = True

End Sub

В качестве примечания: если вы используете один и тот же точный диапазон более одного раза, это неплохая идея.идти вперед и установить этот диапазон переменной.Таким образом, мы дважды используем rngIntersect в этом коде, поэтому нам не нужно выполнять несколько вызовов функций Intersect() и Union().Кроме того, вы сталкиваетесь с меньшим количеством проблем отладки, когда вам нужно обновить диапазон только в одном месте, а не несколько раз в коде.