检查 Excel 工作表中的空(未填写)记录
Checking on empty (not filled) records in Excel Worksheet
我有 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
但它仍然让我退出工作表,即使有空记录
是否有任何方法可以修改此代码 - 因此在记录填充值之前无法关闭我的工作表?
(我在“关闭前”事件中使用了这段代码)
请尝试以下代码。我根据您在评论中的要求修改了几行。
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
此致。
我有 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
但它仍然让我退出工作表,即使有空记录
是否有任何方法可以修改此代码 - 因此在记录填充值之前无法关闭我的工作表?
(我在“关闭前”事件中使用了这段代码)
请尝试以下代码。我根据您在评论中的要求修改了几行。
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
此致。