Код Excel VBA, чтобы проверить, является ли ячейка пустой на основе данных другой ячейки

Question

У меня есть электронная таблица, которую ежедневно заполняют несколько пользователей. В этой таблице есть три отдельных вопроса Да / Нет. Если они вводят Да, то в следующем столбце они должны ввести данные. Я хочу создать код VBA, чтобы проверить и убедиться, что эти данные введены, чтобы нам не приходилось отправлять электронные таблицы обратно пользователям, чтобы заполнить недостающие данные.

Мои данные настроены так: K12: K111, N12: N111 и P12: P111 - все столбцы Да / Нет, а L12: L111, O12: O111 и Q12: Q111 - это ячейки, которые запрашивать ТОЛЬКО текст, если в столбцах K, N или P указано «Да». Может ли кто-нибудь помочь мне с кодированием для этого?

В идеале я хотел бы поместить кнопку ActiveX в электронную таблицу, чтобы по возможности запустить код VBA. Я также хотел бы, чтобы в нем отображалось диалоговое окно, сообщающее, в какие ячейки необходимо вводить данные. Любая помощь будет принята с благодарностью!

РЕДАКТИРОВАТЬ: я изменил диапазоны с M на N, как я неправильно написал в своем первоначальном посте. Я использовал код, предложенный ниже, и получаю ошибку компиляции: недопустимая внутренняя процедура. Вот как я его вставил, чтобы соответствовать кнопке:

Private Sub CommandButton2_Click()
Option Explicit

Sub test()

    Dim rngK As Range, rngN As Range, rngP As Range, cell As Range
    Dim Counter As Long

    Counter = 0

    With ThisWorkbook.Worksheets("Sheet1")

        Set rngK = .Range("K12:K111")
        Set rngN = .Range("N12:N111")
        Set rngP = .Range("P12:P111")

        For Each cell In rngK

            If cell.Value = "Yes" And cell.Offset(0, 1).Value = "" Then

                cell.Offset(0, 1).Interior.Color = vbRed
                Counter = Counter + 1

            End If

        Next cell

        For Each cell In rngN

            If cell.Value = "Yes" And cell.Offset(0, 1).Value = "" Then

                cell.Offset(0, 1).Interior.Color = vbRed
                Counter = Counter + 1

            End If

        Next cell

        For Each cell In rngP

            If cell.Value = "Yes" And cell.Offset(0, 1).Value = "" Then

                cell.Offset(0, 1).Interior.Color = vbRed
                Counter = Counter + 1

            End If

        Next cell

        If Counter > 0 Then

            MsgBox "Please fill red highlighted fields!"

        End If

    End With

End Sub

End Sub

Answer 1

Вы можете попробовать следующее:

Option Explicit

Sub test()

    Dim rngK As Range, rngM As Range, rngP As Range, cell As Range
    Dim Counter As Long

    Counter = 0

    With ThisWorkbook.Worksheets("Sheet1")

        Set rngK = .Range("K12:K111")
        Set rngM = .Range("M12:M111")
        Set rngP = .Range("P12:P111")

        For Each cell In rngK

            If cell.Value = "Yes" And cell.Offset(0, 1).Value = "" Then

                cell.Offset(0, 1).Interior.Color = vbRed
                Counter = Counter + 1

            End If

        Next cell

        For Each cell In rngM

            If cell.Value = "Yes" And cell.Offset(0, 2).Value = "" Then

                cell.Offset(0, 2).Interior.Color = vbRed
                Counter = Counter + 1

            End If

        Next cell

        For Each cell In rngP

            If cell.Value = "Yes" And cell.Offset(0, 1).Value = "" Then

                cell.Offset(0, 1).Interior.Color = vbRed
                Counter = Counter + 1

            End If

        Next cell

        If Counter > 0 Then

            MsgBox "Please fill red highlighted fields!"

        End If

    End With

End Sub

Согласно запросу OP:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Me.Range("K12:K111, M12:M111,P12:P111")) Is Nothing Then

        With Target

            If UCase(.Value) = "YES" Then
                .Offset(0, 1).Interior.Color = vbRed
            Else
                .Offset(0, 1).Interior.Pattern = xlNone
            End If

        End With

    End If

    If Not Intersect(Target, Me.Range("L12:L111, O12:O111,Q12:Q111")) Is Nothing Then

        With Target

            If .Value = "" And UCase(.Offset(0, -1).Value) = "YES" Then
                .Offset(0, 1).Interior.Color = vbRed
            Else
                .Interior.Pattern = xlNone
            End If

        End With

    End If

End Sub