Excel VBA 用于检查单元格空白是否基于另一个单元格数据的代码

Question

我有一个电子表格，每天有多个用户填写并上交。在此电子表格中，有三个单独的 Yes/No 问题。如果他们输入是，则他们必须在下一列中输入数据。我想制作一个 VBA 代码来检查并确保输入了这些数据，这样我们就不必不断将电子表格发回给用户来填写缺失的数据。

我的数据是这样设置的：K12:K111、N12:N111和P12:P111都是Yes/No列，而L12:L111、O12:O111 和 Q12:Q111 是仅当 "Yes" 被放入 K、N 或 P 列时才需要文本的单元格。有人可以帮我编写代码吗？

如果可能的话，我希望在电子表格上放置一个 ActiveX 按钮到运行 VBA 代码。我还希望它显示一个对话框，告诉哪些单元格需要输入数据。任何帮助将不胜感激！

编辑：我确实将范围从 M 更改为 N，因为我在原来的 post 中说错了。我使用了下面建议的代码，但出现编译错误：内部过程无效。这是我将其粘贴到对应于按钮的方式：

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

Excel VBA 用于检查单元格空白是否基于另一个单元格数据的代码

Excel VBA code to check if cell blank based on another cell's data

excel

vba

activex