Excel VBA宏执行后如何根据空单元格统计结果动态选择目标区域

现有代码无法正确选中目标单元格区域的核心问题有三点：

• tToT函数仅声明了choice范围对象，未给其赋值任何实际单元格地址就直接调用Select方法，会直接触发运行时错误，无法完成选择操作
• 代码大量依赖Select、Selection这类宏录制生成的写法，运行效率低，且插入列后的列偏移计算没有同步更新，极易出现范围偏移
• 自定义函数命名为split，和VBA内置的字符串分割函数重名，存在逻辑冲突风险

移除冗余的选中操作，明确范围计算逻辑，修正后的可直接运行代码如下：

Option Explicit

Public Sub emptysinder()
    Dim g As Long
    Dim r As Range
    Dim num As Integer
    Dim ws As Worksheet
    
    ' 绑定操作工作表，避免激活表指向错误
    Set ws = ActiveSheet
    num = 0
    
    ' 直接清除全表单元格内的多余空格，无需选中单元格
    ws.Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
        
    ' 统计F列开始连续9列（F:N列）中，前200行整列全空的列数量
    For g = 1 To 9
        Set r = ws.Range("F1").Offset(0, g - 1).Resize(200, 1)
        If IsAllEmpty(r) Then
            num = num + 1
            Debug.Print "Range " & r.Address & " is all empty. 累计空列数：" & num
        ElseIf IsAnyEmpty(r) Then
            Debug.Print "Range " & r.Address & " is partially empty."
        Else
            Debug.Print "Range " & r.Address & " filled."
        End If
    Next g
    
    ' 执行分隔列插入逻辑
    InsertSeparateColumns ws, num
    ' 选中目标范围
    SelectTargetRange ws, num
End Sub

' 判断指定范围是否全为空
Public Function IsAllEmpty(ByVal r_range As Range) As Boolean
    IsAllEmpty = WorksheetFunction.CountA(r_range) = 0
End Function

' 判断指定范围是否存在空单元格
Public Function IsAnyEmpty(ByVal r_range As Range) As Boolean
    IsAnyEmpty = r_range.Count - WorksheetFunction.CountA(r_range) > 0
End Function

' 原split函数重命名，避免和内置函数冲突，移除冗余选中操作
Public Sub InsertSeparateColumns(ws As Worksheet, emptyColNum As Integer)
    Dim baseCol As Integer
    Dim insertCol As Integer
    Dim remainProcessCol As Integer
    baseCol = 15 ' 原逻辑固定以O列为基准列
    remainProcessCol = baseCol - 6 - emptyColNum
    insertCol = baseCol - emptyColNum
    
    Do While remainProcessCol > 0
        ' 直接在目标位置插入4列，无需选中列
        ws.Columns(insertCol).Resize(, 4).Insert
        insertCol = insertCol - 1
        remainProcessCol = remainProcessCol - 1
    Loop
End Sub

' 修正后的目标区域选择逻辑
Public Sub SelectTargetRange(ws As Worksheet, emptyColNum As Integer)
    Dim baseCol As Integer
    Dim dataStartCol As Integer
    Dim targetRng As Range
    baseCol = 15
    ' 计算插列完成后实际数据的起始列位置（累加所有插入列的偏移量）
    dataStartCol = baseCol + (baseCol - 6 - emptyColNum) * 4
    ' 定义选中范围：200行高度，宽度为有效数据列数
    Set targetRng = ws.Cells(1, dataStartCol).Resize(200, 6 + emptyColNum)
    
    ' 最终执行一次选中操作即可
    targetRng.Select
End Sub

• 移除所有宏录制生成的冗余Select、ActiveCell、Selection写法，直接通过工作表对象操作单元格，运行效率提升明显，也避免了选中状态变化导致的逻辑错误
• 重写空单元格判断逻辑，调用内置CountA函数统计非空单元格数量，无需逐单元格遍历，执行速度更快
• 补全插入列后的偏移量计算逻辑，插入列会让原有数据列向右偏移，必须把总插入列数计入偏移量才能准确定位目标范围
• 增加工作表对象的显式绑定，避免跨表操作时范围指向错误

如果你的目标选中范围规则和示例默认逻辑不一致，仅需要修改SelectTargetRange过程中targetRng的赋值规则即可，其余逻辑无需调整。

内容的提问来源于stack exchange，提问作者Karma Is Krazy