Excel VBA中如何动态设置Cleanup脚本的清理范围？

一、修正获取Dump表最大行号的错误 #

你之前的代码错误在于用Set给数值类型变量赋值——Set仅用于对象（如Range、Worksheet），数值类型直接赋值即可。正确获取Dump表（Sheet8）D列最大行号的代码如下：

Dim maxDumpRow As Long
With Sheets(8)
    maxDumpRow = .Cells(.Rows.Count, "D").End(xlUp).Row
End With

二、优化Cleanup脚本：动态设置清理范围 #

我们可以把单张工作表的清理逻辑封装成独立子过程，避免重复代码，同时支持动态范围：

方案1：基于Dump表最大行号清理 #

适合确保目标表数据不会超过Dump表行数的场景：

Sub Cleanup()
    Dim maxDumpRow As Long
    ' 获取Dump表D列最大行号
    With Sheets(8)
        maxDumpRow = .Cells(.Rows.Count, "D").End(xlUp).Row
    End With
    
    ' 批量清理目标工作表
    CleanSingleSheet Sheets(3), maxDumpRow
    CleanSingleSheet Sheets(4), maxDumpRow
    CleanSingleSheet Sheets(5), maxDumpRow
    CleanSingleSheet Sheets(6), maxDumpRow
    CleanSingleSheet Sheets(7), maxDumpRow
End Sub

' 封装清理单张工作表的子过程
Sub CleanSingleSheet(targetSheet As Worksheet, maxRow As Long)
    Dim i As Long
    ' 倒序遍历避免删除行导致的索引混乱
    For i = maxRow To 1 Step -1
        If WorksheetFunction.CountA(targetSheet.Rows(i)) = 0 Then
            targetSheet.Rows(i).Delete
        End If
    Next i
End Sub

方案2：基于目标表自身有效范围清理（更精准） #

如果目标表可能存在历史数据超过Dump表行数，直接获取目标表的最后有效行：

Sub Cleanup()
    CleanSingleSheet Sheets(3)
    CleanSingleSheet Sheets(4)
    CleanSingleSheet Sheets(5)
    CleanSingleSheet Sheets(6)
    CleanSingleSheet Sheets(7)
End Sub

Sub CleanSingleSheet(targetSheet As Worksheet)
    Dim lastRow As Long
    Dim i As Long
    ' 获取目标表O列最后有效行（覆盖A-O列数据范围）
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, "O").End(xlUp).Row
    If lastRow < 1 Then Exit Sub ' 无数据时直接退出
    
    For i = lastRow To 1 Step -1
        If WorksheetFunction.CountA(targetSheet.Rows(i)) = 0 Then
            targetSheet.Rows(i).Delete
        End If
    Next i
End Sub

三、额外优化：从源头避免空行（替代Cleanup） #

你的原Autosort脚本因保留原行位置导致空行，可直接修改为将数据复制到目标表的最后一行下方，彻底省去Cleanup步骤，同时提升效率：

Option Explicit

Sub Autosort()
    Dim cell As Range
    Dim targetSheet As Worksheet
    Dim maxDumpRow As Long
    
    With Sheets(8)
        maxDumpRow = .Cells(.Rows.Count, "D").End(xlUp).Row
        ' 仅循环一次D列，提升效率
        For Each cell In .Range("D1:D" & maxDumpRow)
            Select Case cell.Value
                Case "Laptop": Set targetSheet = Sheets(2)
                Case "Monitor": Set targetSheet = Sheets(4)
                Case "Serialized Docks": Set targetSheet = Sheets(3)
                Case "Peripheral": Set targetSheet = Sheets(5)
                Case "Serialized Audio": Set targetSheet = Sheets(6)
                Case "Modem", "AP", "Switch": Set targetSheet = Sheets(7)
                Case Else: Set targetSheet = Nothing ' 未匹配类型跳过
            End Select
            
            ' 复制到目标表的下一行，无空行
            If Not targetSheet Is Nothing Then
                .Rows(cell.Row).Copy Destination:=targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
        Next cell
    End With
End Sub

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