时间戳

首页 > 解决方案 > 检查 Excel 工作表中的空（未填充）记录

excel - 检查 Excel 工作表中的空（未填充）记录

问题描述

我有 excel 工作表，我在其中使用了以下 vba 代码来检查空记录：

     Private Sub Workbook_BeforeClose(Cancel As Boolean)
     On Error GoTo NoBlanks
  
     Dim sh As Worksheet, lastRow As Long, lastCol As Long, emptyCells As Range

    Set sh = ActiveSheet 'use here your sheet
    lastRow = sh.Range("A" & Rows.Count).End(xlUp).Row
    lastCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column

    Set emptyCells = sh.Range(sh.Cells(1, 1), sh.Cells(lastRow, 
                                                       lastCol)).SpecialCells(xlCellTypeBlanks)
    If emptyCells.Cells.Count > 0 Then
    MsgBox "There are empty cells, which must be filled: " & emptyCells.Address(0, 0)
    emptyCells.Select
    Else
       Resume Next
   Exit Sub
 End If

  NoBlanks:
     Resume Next

  End Sub

但它仍然让我退出工作表，即使有空记录

有什么方法可以修改此代码 - 因此在记录填充值之前无法关闭我的工作表？

（我在“关闭前”事件中使用了这段代码）

标签： excelvbarows

解决方案

请尝试以下代码。我根据您在评论中的要求修改了几行。

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  
Dim sh As Worksheet, lastRow As Long, lastCol As Long, emptyCells As Range

Set sh = ActiveSheet 'use here your sheet
lastRow = sh.Range("A" & Rows.Count).End(xlUp).Row
'lastRow = sh.UsedRange.Rows.Count

lastCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column
'lastCol = sh.UsedRange.Columns.Count

On Error GoTo NoBlanks
Set emptyCells = sh.Range(sh.Cells(1, 1), sh.Cells(lastRow, _
 lastCol)).SpecialCells(xlCellTypeBlanks)

    If Not emptyCells Is Nothing Then    
        MsgBox "There are empty cells, which must be filled: " & emptyCells.Address(0, 0)
        emptyCells.Interior.Color = RGB(255, 0, 255)
        Cancel = True
    Else  
NoBlanks:
        Cancel = False
        sh.Range(sh.Cells(1, 1), sh.Cells(lastRow, _
 lastCol)).Interior.ColorIndex = 0
        If Me.Saved = False Then Me.Save
        'Workbook will be saved & closed if all cells in UsedRange are filled
    End If
End Sub

问候。

推荐阅读