Мониторинг изменений листа Excel VBA - PullRequest
0 голосов
/ 31 мая 2018

У меня есть лист Excel, который должен вести себя определенным образом.

Например, ячейки I11 - I20 - это ячейки пользовательского ввода в форме раскрывающегося списка.

Для этих ячеек мне нужно отслеживать, выбирает ли пользователь значение, которое меньше числа 900.

Если пользователь выбирает, например, число меньше 900 для ячейки I11, мне нужноустановить для ячейки формулу K11 = J11.

Если пользователь выбирает число больше 900, тогда я очищаю формулу и разрешаю вводить ячейку.

Мне нужно сделать этодля всех ячеек, которые варьируются от I11-I20.

Вот то, что у меня есть для одной ячейки, однако я получаю ошибку, в которой говорится «переменная объекта или переменная блока не установлена», и это позволяет мне изменить только однустрока.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A As Range
    Set A = Range("I11")
    If Intersect(Target, A) > 900 Then A.Offset(0, 2).Value = ""
    Application.EnableEvents = False
        A.Offset(0, 2).Value = "=J11"
    Application.EnableEvents = True
End Sub

Спасибо за любую помощь.

Ответы [ 2 ]

0 голосов
/ 31 мая 2018

Вы уже указали target.range, события включения не потребуются.Вам не потребуется формула, просто сделайте ячейку равной другой ячейке.

Так что, если в столбце I есть изменение, а значение> 900, очистите ячейку на 2 столбца.Если изменение <= 900, тогда сделайте ячейку на два столбца равной столбцу ячейки 1. </p>

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub    ' this stops code error if more than one cell is changed at once

    If Not Application.Intersect(Target, Me.Range("I1:I100")) Is Nothing Then    ' indicates the Target range
        If Target > 900 Then
            Target.Offset(, 2) = ""
        Else: Target.Offset(, 2).Value = Target.Offset(, 1).Value
        End If
    End If
End Sub
0 голосов
/ 31 мая 2018
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("I11:I20")) Is Nothing Then
            Application.EnableEvents = False
                If Target > 900 Then
                    Target.Offset(0, 2).ClearContents
                Else
                    Target.Offset(0, 2).Formula = "=J" & Target.Row
                End If
            Application.EnableEvents = True
        End If
    End If
End Sub
...