Excel VBA代码根据另一个单元格的数据检查单元格是否为空白

Question

我有一个电子表格，多个用户每天填写并上交。 在这个电子表格中有三个单独的是/否问题。 如果他们输入 Yes，那么他们必须在以下列中输入数据。 我想制作一个 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