如何让VBA的Selection.End(xlDown)跳过空白选中下方全量数据

更新补充 #

数据中存在异常空白单元格（正常场景下该位置无空白），需要实现：当空白单元格下方仍存在有值单元格时，让selection.end(xldown)跳过空白，选中完整数据范围。

近期日常使用的多个宏运行效果不符合预期，两个典型问题示例如下：

• 下述宏预期选中20行含数据的内容，实际仅选中最上方2行：

Sub Import_Fee_Data()
' This is to import the data from the spreadsheet exported from Client Central
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Import Fee Data", FileFilter:="CSV Files (*.csv*),*csv*")

If FileToOpen <> False Then
    Set OpenBook = Application.Workbooks.Open(FileToOpen)
    OpenBook.Sheets(1).Range("B2:P2").Select
    OpenBook.Sheets(1).Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ThisWorkbook.Worksheets("Fee Summary Data").Range("A1").PasteSpecial
        
    OpenBook.Application.CutCopyMode = False
    OpenBook.Close False
End If

Application.ScreenUpdating = True
End Sub

• 以下代码运行时同样仅选中最上方2行数据：

Sub CutAndInsert()

If CountRows = ThisWorkbook.Worksheets("Fee Summary Data").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count > 200 Then
    MsgBox ("Due to the number of transactions please reach out to David Wallenburg for assistance.")
    Exit Sub
End If

Sheets("Fee Summary Data").Select
Range("A1:F1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut

Sheets("Fee Letter Formatted").Select
Range("A6:F6").Select
Selection.Insert xlShiftDown

Application.CutCopyMode = False

End Sub

xlDown的运行逻辑和手动按Ctrl+方向下键完全一致：遇到第一个空白单元格就会终止定位，只要起始行下方存在空单元格、或者连续数据段中间夹了空白行，就会停在空白行的上一行，不会继续检索下方的剩余数据。两个宏都只选中前2行，核心原因就是第3行刚好是那个异常空白单元格，直接截断了定位。

不要用从顶部向下xlDown的定位逻辑，改成从工作表对应列的最底部向上查找最后一个有值单元格的行号，这种写法从逻辑上就会跳过中间所有空白单元格，不会被空值截断定位结果。

修正后的代码 #

1. Import_Fee_Data 宏修正 #

替换原有依赖选中状态的区域选择逻辑，直接计算最后一行行号，不需要逐次选中单元格即可操作，运行更稳定：

Sub Import_Fee_Data()
' This is to import the data from the spreadsheet exported from Client Central
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim lastRow As Long
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Import Fee Data", FileFilter:="CSV Files (*.csv*),*csv*")

If FileToOpen <> False Then
    Set OpenBook = Application.Workbooks.Open(FileToOpen)
    ' 从B列最底部往上找最后一个有值单元格的行号，不受中间空白影响
    lastRow = OpenBook.Sheets(1).Cells(OpenBook.Sheets(1).Rows.Count, "B").End(xlUp).Row
    ' 直接选中B2到P列最后一行的完整范围执行复制
    OpenBook.Sheets(1).Range("B2:P" & lastRow).Copy
    ThisWorkbook.Worksheets("Fee Summary Data").Range("A1").PasteSpecial
        
    OpenBook.Application.CutCopyMode = False
    OpenBook.Close False
End If

Application.ScreenUpdating = True
End Sub

2. CutAndInsert 宏修正 #

同步替换区域定位逻辑，同时修正原代码中CountRows判断的语法错误：

Sub CutAndInsert()
Dim lastRow As Long
Dim rowCount As Long
' 修正原判断的语法问题，正确计算A列常量单元格数量
rowCount = ThisWorkbook.Worksheets("Fee Summary Data").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
If rowCount > 200 Then
    MsgBox ("Due to the number of transactions please reach out to David Wallenburg for assistance.")
    Exit Sub
End If

' 从A列底部往上找最后一行，跳过中间所有空白
lastRow = ThisWorkbook.Worksheets("Fee Summary Data").Cells(ThisWorkbook.Worksheets("Fee Summary Data").Rows.Count, "A").End(xlUp).Row
' 直接取A1到F列最后一行的范围执行剪切插入，不需要逐次选中
Sheets("Fee Summary Data").Range("A1:F" & lastRow).Cut
Sheets("Fee Letter Formatted").Range("A6:F6").Insert xlShiftDown

Application.CutCopyMode = False

End Sub

补充说明 #

• 从列底用xlUp定位最后行是VBA中获取数据范围的通用标准写法，不管数据中间夹了多少个空白单元格，都能准确定位到整列最末尾的有值行
• 代码里尽量减少.Select、.Selection这类依赖选中状态的写法，直接操作Range对象运行速度更快，也不会因为屏幕刷新、选中状态意外变化导致运行异常
• 如果数据区域里的空白是公式返回的空文本（不是真正的空单元格），只需要在定位最后行时适配单元格类型即可，核心逻辑不变

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