我想运行检查以查看范围内的所有单元格是否为空，如果是则退出子

Question

我有一个 Workbook_Before Close 子项目，它具有三个不同的条件。首先，它应该检查范围内的所有单元格是否为空（L5：L），如果是，那么我希望它退出子单元。如果范围中的任何单元格不为空，但两个特定单元格（L65 和 L66）为空，则应返回一个消息框，告诉用户这两个单元格需要在其中包含值（或一个单元格，具体取决于一个或多个单元格）其他都是空的）。如果您尝试关闭包含范围 (L5:L) 中包含数据的任何单元格的工作簿，它应该会阻止您关闭它，直到 a) (L5:L) 中的数据被清除，或 b) 输入数据进入细胞 L65 和 L66。现在，当范围不为空并且两个单元格为空时，它允许关闭工作簿。

下面是我尝试过的代码。

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim rngCell As Range
Dim lngLstRow As Long

If ActiveSheet.Name = "Instruction & Data Input" Then

    lngLstRow = ActiveSheet.UsedRange.Rows.Count

    For Each rngCell In Range("L5:L" & lngLstRow)

        If rngCell.Value = "" Then
Exit Sub
              Exit For
               End If
                           Next
                           
       For Each rngCell In Range("L5:L" & lngLstRow)

        If rngCell.Value <> "" And rngCell.Offset(2, 0) = "" Then
            
            MsgBox ("Please add battery terminal  connection (+) resistance reading to sheet in yellow highlighted cells. This reading is taken from the incoming charger controller connection to the first battery terminal lug. ")
            
        
               Exit For
               End If
                           Next
            
        For Each rngCell In Range("L5:L" & lngLstRow)
            
            If rngCell.Value <> "" And rngCell.Offset(3, 0) = "" Then
                       
            MsgBox ("Please add battery terminal  connection (-) resistance reading to sheet in yellow highlighted cells. This reading is taken from the last battery to the out going charger controller connection.")

                               
                      
            Exit For
         End If
         Next
        
     
End If
End Sub

Answer 1

试试这个：

Private Sub Workbook_BeforeClose()

    Dim c As Range, rng As Range, lngLstRow As Long, ws As Worksheet, v, stopClose As Boolean, colOffset
    Dim Cancel As Boolean
    Set ws = ThisWorkbook.Worksheets("Instruction & Data Input") 'reference specific worksheet
    
    lngLstRow = ws.Cells(Rows.Count, "L").End(xlUp).Row 'last cell in Col L with content
    If lngLstRow < 5 Then Exit Sub  'range is empty?

    'check each cell in Col L used range
    For Each c In ws.Range("L5:L" & lngLstRow).Cells
        v = c.Value
        If Len(v) > 0 Then
            For Each colOffset In Array(2, 3) 'checking cells 2 and 3 columns to the right
                With c.Offset(0, colOffset)  'the cell to be checked
                    .FormatConditions.Delete 'clear any existing CF flag
                    If Len(.Value) = 0 Then  'empty?
                        AddCFFill .Cells(1), vbRed 'flag the cell
                        stopClose = True           'at least one cell with a problem
                    End If 'required cell is empty
                End With
            Next colOffset  'check next column
        End If
    Next c
    
    If stopClose Then  'any cells with a problem? Alert the user and cancel close
        MsgBox "Some required values are missing! (see red-filled cells)" & vbLf & _
               "...rest of message here describes what's missing"
        
        Cancel = True 'cancel the close
    End If
    
End Sub

'Add a fill to a cell/range using a FormatCondition
'  Allows to revert to any previous fill on deleting the CF
Sub AddCFFill(c As Range, clr As Long)
    With c.FormatConditions.Add(Type:=xlExpression, Formula1:="=TRUE")
        .SetFirstPriority
        .Interior.Color = clr
    End With
End Sub