Событие изменения рабочего листа - проверьте ячейки в столбце на разницу

Question

Я изо всех сил пытаюсь заставить событие Worksheet_Change работать, чтобы проверить, есть ли разница% больше чем 10% между диапазоном G12: 42 и диапазоном J12: 42. У меня есть расчет в диапазоне G12: 42, который, кажется, вызывает у меня некоторую головную боль.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim diffPercent
    'Check that the data is changed between row 12 and 42 and it is even row. eg 12,14,16...42.
    If (Target.Row > 12 And Target.Row < 42) And ((Target.Row Mod 2) = 0) Then  'And _
            '(Target.Column = 7 Or Target.Column = 10) Then

        'Get the values in J ang G columns of that particular row.
        number1 = Range("G" & Target.Row).Value
        number2 = Range("J" & Target.Row).Value

        'Check for presence of both the inputs to calculate difference in percentage.
        If Not chkInputs(number1, number2) Then
            Exit Sub
        End If
        'Calculate the percentage difference.
        diff = number2 - number1
        diffPercent = (diff / number2) * 100

        'Give alert if difference more than 10 percent
        If diffPercent > 10 Then
            MsgBox "Oppps. Your system is not working!"
        End If
    End If

End Sub

Function chkInputs(number1, number2)
chkInputs = False
If IsNumeric(number1) And IsNumeric(number2) Then
    chkInputs = True
End If

End Function

Ожидаемым результатом является запуск сообщения MsgBox, предоставляющего сообщение.

Answer 1

Не нужно иметь отдельную функцию.Вы можете включить его в основной код.Также используйте Intersect для работы с соответствующим диапазоном, иначе код сработает, если в этом диапазоне строк произойдет изменение.Еще кое-что.Проверьте, не является ли ячейка в столбце J 0, иначе вы получите ошибку переполнения.

Возможно, вы также захотите увидеть Работа с Worksheet_Change

Это то, чтоВы пытаетесь ( Не проверено )?

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngToCheck As Range
    Dim NumA As Variant, NumB As Variant
    Dim i As Long

    On Error GoTo Whoa

    '~~> Set the relevant range
    Set rngToCheck = Union(Range("G12:G42"), Range("J12:J42"))

    Application.EnableEvents = False

    If Not Intersect(Target, rngToCheck) Is Nothing Then
        For i = 12 To 42 Step 2 '<~~ Loop through only even rows
            NumA = Range("G" & i).Value
            NumB = Range("J" & i).Value

            If IsNumeric(NumA) And IsNumeric(NumB) And NumB <> 0 Then
                If ((NumA - NumB) / NumB) * 100 > 10 Then
                    MsgBox "Please check the value of Col G and J Cells in row " & i
                    Exit For
                End If
            End If
        Next i
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub