VBA执行后无法通过选中A1取消数据行选中状态的技术问题

手动选中A1可取消工作表中所有数据行的选中状态，但执行Copy_Prior_Sales函数后出现以下问题：

• 目标工作表wsName_Target_Sheet仍保持所有数据行选中，多次选中A1无效；
• 遍历所有工作表选中A1的宏无法解决该问题，担心用户误触删除键清空数据。

相关代码 #

Copy_Prior_Sales函数 #

Function Copy_Prior_Sales(wsName_Target_Sheet As String, wsName_Source_Sheet As String, Targeted_Row As Integer) As Integer

    Dim lastRow As Integer
    Dim Start_Row As Integer, Target_Row As Integer
    If IsMissing(Targeted_Row) = True Or IsNumeric(Targeted_Row) = False Or Targeted_Row < 1 Then
        Target_Row = 1
    Else
        Target_Row = Targeted_Row
    End If
    If Target_Row > 1 Then
        Start_Row = 2
    Else
        Start_Row = 1
    End If

    Application.ScreenUpdating = False
    Sheets(wsName_Source_Sheet).Select
    lastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A" & Start_Row & ":I" & lastRow).Select
    Selection.Copy

    Sheets(wsName_Target_Sheet).Select
    Range("A" & Target_Row).Select
    ActiveSheet.Paste
    Range("A1").Select
    
    Range("A1:I" & lastRow).Select
    Range("A1:I" & lastRow).Columns.AutoFit
    Application.CutCopyMode = False
    Range("A1").Select

    Sheets(wsName_Source_Sheet).Select
    Range("A1").Select
    Application.CutCopyMode = False
    Copy_Prior_Sales = lastRow
    Application.ScreenUpdating = True
    
End Function

遍历工作表宏 #

Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
    Range("A1").Select
Next ws
Application.ScreenUpdating = True

解决方案 #

1. 修复Copy_Prior_Sales函数的选中问题 #

问题根源在于函数中大量使用Select/Selection操作，且ScreenUpdating关闭时界面刷新不及时，导致选中状态未同步。优化核心是直接操作工作表/范围对象，避免选中操作，同时确保最终焦点定位到A1。

修改后的函数：

Function Copy_Prior_Sales(wsName_Target_Sheet As String, wsName_Source_Sheet As String, Optional Targeted_Row As Integer = 1) As Integer
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRow As Integer, Start_Row As Integer
    
    ' 参数校验
    If Targeted_Row < 1 Then Targeted_Row = 1
    Start_Row = IIf(Targeted_Row > 1, 2, 1)
    
    Set wsSource = ThisWorkbook.Sheets(wsName_Source_Sheet)
    Set wsTarget = ThisWorkbook.Sheets(wsName_Target_Sheet)
    
    Application.ScreenUpdating = False
    
    ' 获取源表最后一行
    lastRow = wsSource.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    ' 直接复制粘贴，无需选中
    wsSource.Range("A" & Start_Row & ":I" & lastRow).Copy _
        Destination:=wsTarget.Range("A" & Targeted_Row)
    
    ' 直接设置自动列宽，无需选中
    wsTarget.Range("A1:I" & lastRow + Targeted_Row - 1).Columns.AutoFit
    
    ' 定位到目标表A1
    wsTarget.Activate
    wsTarget.Range("A1").Select
    
    ' 源表定位到A1
    wsSource.Activate
    wsSource.Range("A1").Select
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    Copy_Prior_Sales = lastRow
End Function

2. 修复遍历工作表的宏 #

原宏未指定工作表对象，Range("A1").Select只会操作当前激活的工作表，导致遍历无效。修改后：

Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
    ws.Activate
    ws.Range("A1").Select
Next ws
' 可选：最后回到第一个工作表
ThisWorkbook.Sheets(1).Activate
Application.ScreenUpdating = True

额外简化方案 #

若仅需取消大范围选中状态，无需强制选中A1，可直接使用：

' 快速将焦点定位到A1，取消当前选中范围
Application.Goto ActiveSheet.Range("A1"), Scroll:=True

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