Код VBA MsgBox, если 2 критерия для каждой строки в таблице

Question

У меня есть код, который просматривает 2 разные ячейки и отображает всплывающее окно каждый раз, когда обе ячейки имеют определенные критерии, однако он делает это только для этой конкретной строки.

Я ищу способ иметь 1 код, который будет искать каждую пару ячеек в каждой строке и оценивать их независимо.

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

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, Me.Range("A:B")) Is Nothing Then
         If (Range("A2").Value = "Text1") And Range("B2").Value > ### Then MsgBox "Message"

End If

End Sub

Код должен смотреть на всю таблицу, состоящую из 200 строк, и в идеале продолжать искать, увеличивается ли таблица по определенным критериям в каждой строке, все A2 и B2, A3 и B3 и так далее. В настоящее время он рассматривает только те ячейки, которые я выбрал, и единственное решение, которое я могу придумать, это скопировать вставку и изменить диапазоны для каждого нового фрагмента кода.

Спасибо!

Answer 1

Вы можете попробовать это:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngTable As Range
    Dim Lastrow As Long

    With ActiveSheet
        'Calculate table last row
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        'Set rng to search (FROM Column A row 2 TO Column B row 5)
        Set rngTable = .Range(Cells(2, 1), Cells(Lastrow, 2))
        'Check if tha target included in the table
        If Not Intersect(Target, rngTable) Is Nothing Then
            'Check if the target and the cell next to it are equal
            If Target.Value = Target.Offset(0, -1).Value Then
                'if both cells are equal meesage with there address will appear
                MsgBox "Cells " & Replace(Target.Offset(0, -1).Address, "$", "") & " and " & Replace(Target.Address, "$", "") & " are the same!"
            End If

        End If
    End With

End Sub

Структура листа:

Answer 2

Просто зациклите столбцы A и B:

Option Explicit
Sub LookUpWithMessageBox()
    Dim lastRow As Long, i As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lastRow
        If Cells(i, 1).Value = "column A criteria" And Cells(i, 2).Value = "column B criteria" Then MsgBox Cells(i, 1).Value & " " & Cells(i, 2).Value
    Next
End Sub