VBA多列日期条件行移动优化：空值判断与列写法改进

需求背景 #

原VBA代码可将「Verlopen Keuring」工作表中F-H列全部日期≥当前日期的行移动至「Afgehandeld」工作表，但存在两个局限：一是F-H列有空白时直接不满足条件；二是校验列需逐个硬编码。现需优化为：

• 若F-H列存在空值，仅校验已填写日期的列，只要这些列的日期均≥当前日期就移动该行；
• 用一行代码指定校验列范围，无需逐个列硬编码。

优化后的代码 #

Sub MoveBasedOnValue5()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRowSource As Long, lastRowTarget As Long
    Dim checkRange As Range, cell As Range
    Dim isQualified As Boolean
    Dim x As Long
    
    ' 定义工作表对象，简化后续引用
    Set wsSource = ThisWorkbook.Sheets("Verlopen Keuring")
    Set wsTarget = ThisWorkbook.Sheets("Afgehandeld")
    
    ' 获取两个工作表的最后数据行号
    lastRowSource = wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row
    lastRowTarget = wsTarget.Range("A" & wsTarget.Rows.Count).End(xlUp).Row
    
    ' 一行代码指定需校验的列范围（示例为F到H列，可直接修改）
    Set checkRange = wsSource.Range("F:H")
    
    ' 从最后一行反向遍历，避免删除行导致的索引混乱
    For x = lastRowSource To 2 Step -1
        isQualified = True ' 默认标记为符合条件
        
        ' 遍历当前行的所有校验列
        For Each cell In checkRange.Rows(x - 1).Cells
            If Not IsEmpty(cell.Value) Then ' 仅校验非空单元格
                If cell.Value < Date Then ' 存在非空日期小于当前日期则标记为不符合
                    isQualified = False
                    Exit For ' 提前终止循环，减少不必要的检查
                End If
            End If
        Next cell
        
        ' 符合条件则执行移动操作
        If isQualified Then
            wsSource.Rows(x).Cut wsTarget.Range("A" & lastRowTarget + 1)
            wsSource.Rows(x).Delete
            lastRowTarget = lastRowTarget + 1
        End If
    Next x
End Sub

代码说明 #

1. 动态指定校验列：通过Set checkRange = wsSource.Range("F:H")一行代码即可定义校验列范围，后续调整校验列时只需修改这个Range参数，无需逐个硬编码列地址。
2. 空值兼容逻辑：遍历校验列时，跳过空单元格，仅对已填写的日期进行校验；只要所有非空日期都≥当前日期，就判定该行符合移动条件。
3. 反向遍历行：从最后一行往上遍历，避免删除行后导致的行号错乱问题，确保每一行都能被正确检查。
4. 对象化工作表引用：将源表和目标表定义为Worksheet对象，减少重复代码，提升代码的可读性和维护性。

内容的提问来源于stack exchange，提问作者Steve Put