VBA中如何不统计空白行 解决行数判断恒成立问题

场景需求 #

• 数据存储结构：B列为日期、C列为对应数值，数据起始位置为B2单元格，初始覆盖范围到B569
• 规则要求：仅保留最近60条（对应最近5年）数据；初始数据行数大于60时删除多余旧数据；后续新增数据时自动将所有行上移、删除最旧的首行数据，始终保证B、C列有效数据总行数为60条
• 原有代码问题：Range("B2:B569").Rows.Count 会直接返回固定区域的总行数（包含无数据的空白行），导致判断逻辑始终误触发第一个分支，需要实现仅统计包含有效数据的非空行。

原有问题代码 #

If Range("B2:B569").Rows.Count > 60 Then
 Range("B2:B509").Select
 Selection.Delete shift:=xlUp
 
 Else
 If Range("B2:B569").Rows.Count = 61 Then
 Range("B2:C2").Select
 Selection.Delete shift:=xlUp
 MsgBox "One New Index Value Found"
 
 Else
 If Range("B2:B569").Rows.Count = 60 Then
 MsgBox "Pass"
 
 Else
 
 MsgBox "Fail"

End If
End If
End If
End Sub

修正方案 #

核心计数逻辑 #

不要对固定范围直接取Rows.Count，通过定位B列最后一个非空单元格的位置计算有效数据行数：

• 连续无空行的时序数据（日期序列属于这类）：用Cells(Rows.Count, "B").End(xlUp).Row获取B列最后一个有值单元格的行号，减去起始行的偏移量（B2为起始行，偏移量为1）即可得到有效数据总行数，不会计入下方空白行
• 如果数据中间存在零散空行，可使用WorksheetFunction.CountA(Columns("B")) - 1统计B列所有非空单元格数量（减1为扣除B1位置的表头，无表头可调整该值）

修正后可直接运行的代码 #

Sub MaintainFixedDataRows()
    Dim lastRow As Long, dataCount As Long
    ' 关闭屏幕更新提升运行速度
    Application.ScreenUpdating = False
    
    ' 获取B列最后一个非空单元格行号，计算有效数据条数
    lastRow = Cells(Rows.Count, "B").End(xlUp).Row
    dataCount = lastRow - 1 ' B2为起始行，行号减1得到从B2开始的非空数据条数
    
    ' 分支判断处理
    If dataCount > 60 Then
        ' 删除超出60条的多余旧数据
        Range("B2:C" & 1 + (dataCount - 60)).Delete shift:=xlUp
        MsgBox "已清理多余旧数据，当前保留最新60条记录"
    ElseIf dataCount = 61 Then
        ' 新增1条数据，删除最顶部的旧首行
        Range("B2:C2").Delete shift:=xlUp
        MsgBox "One New Index Value Found"
    ElseIf dataCount = 60 Then
        MsgBox "Pass"
    Else
        MsgBox "Fail，当前有效数据条数不足60，请检查数据源"
    End If
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
End Sub

优化说明 #

• 移除了Select/Selection的选中操作，直接操作目标单元格区域，避免选中状态导致的运行异常，运行效率更高
• 增加屏幕更新开关，大批量删除数据时不会出现屏幕闪烁
• 删除范围自动计算，不需要手动写死固定行号，适配后续数据行位置变化的场景

注意：如果B列存在公式返回空值（比如=""）的情况，End(xlUp)会将这类单元格识别为非空，此时替换为CountA的计数方式即可。

内容的提问来源于stack exchange，提问作者Piyush Mehta