excel - 合并工作表事件

Question

我已经在这方面挑战了自己，但到目前为止都失败了。我有两个 Worksheet_Change 事件，它们是在用户添加数据并在不正确时接收弹出消息的同一概念上触发的。

我试图将它们结合起来，但不断出现错误。

代码 1

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 ((NumB - NumA) / NumA) * 100 < 50 Then
                    MsgBox "The Glass U-value and Total System U-value appear very similar. Please check the input values for accuracy!"
                    Exit For
                End If
            End If
        Next i
    End If

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

代码 2

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim AffectedRange As Range
    Set AffectedRange = Intersect(Target, Me.Columns(3))

    If Not AffectedRange Is Nothing Then
        Dim Cell As Range
        For Each Cell In AffectedRange

            If Application.WorksheetFunction.CountIf(Me.Columns(3), Cell.Value) > 1 Then
                MsgBox "This Glazing Reference already exists. Please ensure you have a unique reference identifier less than 20 characters in length", vbOKOnly + vbExclamation
            End If

        Next Cell
    End If
End Sub

我希望这两个Worksheet_Change事件都能在没有崩溃的情况下运行。

标签： excelvba

Answer 1

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 ((NumB - NumA) / NumA) * 100 < 50 Then
                    MsgBox "The Glass U-value and Total System U-value appear very similar. Please check the input values for accuracy!"
                    Exit For
                End If
            End If
        Next i
    End If

    Dim AffectedRange As Range
    Set AffectedRange = Intersect(Target, Me.Columns(3))

    If Not AffectedRange Is Nothing Then
        Dim Cell As Range
        For Each Cell In AffectedRange

            If Application.WorksheetFunction.CountIf(Me.Columns(3), Cell.Value) > 1 Then
                MsgBox "This Glazing Reference already exists. Please ensure you have a unique reference identifier less than 20 characters in length", vbOKOnly + vbExclamation
            End If

        Next Cell
    End If

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

b