Excel VBA 按ECO编号检索跨工作表复制数据范围报错求助

公司使用Excel工作簿登记工单，所有数据存储在「ECO Database」工作表作为底层数据库，期望实现功能：输入ECO编号后，自动展示该编号及对应关联零件号信息。

当前基于宏录制生成的VBA代码可正常弹出输入框获取ECO编号，但运行时要么触发报错，要么选中整张工作表所有单元格引发内存溢出。

原问题代码 #

Sub PlayMacro()
  Dim Prompt As String
  Dim RetValue As String
  Dim Rng As Range
  Dim RowCrnt As Long
  Prompt = ""
   With Sheets("ECO Database")
    Do While True
      RetValue = InputBox(Prompt & "Type in ECO#")
      If RetValue = "" Then
        Exit Do
      End If
      Set Rng = .Columns("A:A").Find(What:=RetValue, After:=.Range("A1"), _
                LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
      If Rng Is Nothing Then
       Prompt = "ECO""" & RetValue & """Not Found"
      Else
            Sheets("ECO Updates").Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveWindow.SmallScroll Down:=3
    ActiveCell.Range("A1:T49").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("ECO Database").Select
    ActiveCell.Offset(-2, 0).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveCell.Range("A:U").Select
    Selection.Copy
    Sheets("ECO Updates").Select
    ActiveCell.Select
    ActiveSheet.Paste
      End If
      Prompt = Prompt & vbLf
    Loop
  End With
End Sub

• ECO编号存储在「ECO Database」工作表A列，B~U列为对应关联数据
• 不同ECO条目之间预留1行空行作为边界标识

• 检索到对应ECO后，精准选中该条目对应范围数据，复制/剪切到「ECO Updates」工作表调整
• 修改完成后可将调整后的数据回存到数据库工作表原位置

原代码问题出在大量依赖Select、ActiveCell等依赖操作时选中状态的属性，当选中位置不符合预期时就会出现范围选择错误，甚至因为End(xlDown)碰到空单元格直接跳到工作表最底部选中整表。以下是优化后的代码，分两个功能模块：

1. ECO检索导出功能 #

' 存储匹配到的ECO起始行号，用于后续回存
Public ECOStartRow As Long
Sub SearchECO()
    Dim RetValue As String
    Dim Rng As Range
    Dim EndRow As Long
    Dim UpdateSheet As Worksheet
    Dim DBSheet As Worksheet
    
    Set UpdateSheet = ThisWorkbook.Sheets("ECO Updates")
    Set DBSheet = ThisWorkbook.Sheets("ECO Database")
    
    ' 清空编辑区原有内容
    UpdateSheet.Range("A1:U1000").ClearContents
    
    ' 获取输入的ECO编号
    RetValue = InputBox("请输入ECO编号")
    If RetValue = "" Then Exit Sub
    
    ' 匹配ECO编号
    Set Rng = DBSheet.Columns("A:A").Find(What:=RetValue, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    If Rng Is Nothing Then
        MsgBox "ECO """ & RetValue & """ 未找到", vbExclamation
        Exit Sub
    End If
    
    ' 记录ECO起始行号
    ECOStartRow = Rng.Row
    ' 找当前ECO条目的结束行：下一个空行的上一行
    EndRow = DBSheet.Cells(ECOStartRow, "A").End(xlDown).Row
    
    ' 复制对应范围数据到编辑表
    DBSheet.Range(DBSheet.Cells(ECOStartRow, "A"), DBSheet.Cells(EndRow, "U")).Copy _
        Destination:=UpdateSheet.Range("A1")
    
    MsgBox "ECO数据已加载完成，可在ECO Updates表中修改", vbInformation
End Sub

2. 修改后回存功能 #

Sub SaveECOToDB()
    Dim UpdateSheet As Worksheet
    Dim DBSheet As Worksheet
    Dim EndRow As Long
    
    If ECOStartRow = 0 Then
        MsgBox "请先检索ECO数据再执行保存操作", vbExclamation
        Exit Sub
    End If
    
    Set UpdateSheet = ThisWorkbook.Sheets("ECO Updates")
    Set DBSheet = ThisWorkbook.Sheets("ECO Database")
    
    ' 获取编辑区的有效数据行数
    EndRow = UpdateSheet.Cells(Rows.Count, "A").End(xlUp).Row
    If EndRow < 1 Then
        MsgBox "编辑区无有效数据可保存", vbExclamation
        Exit Sub
    End If
    
    ' 先清空数据库原位置的旧数据，再写入新数据
    DBSheet.Range(DBSheet.Cells(ECOStartRow, "A"), DBSheet.Cells(DBSheet.Cells(ECOStartRow, "A").End(xlDown).Row, "U")).ClearContents
    UpdateSheet.Range(UpdateSheet.Cells(1, "A"), UpdateSheet.Cells(EndRow, "U")).Copy _
        Destination:=DBSheet.Cells(ECOStartRow, "A")
    
    MsgBox "数据已成功回存到ECO数据库", vbInformation
    ' 重置起始行标记
    ECOStartRow = 0
End Sub

使用说明 #

• 运行SearchECO宏，输入要编辑的ECO编号即可加载对应数据到「ECO Updates」表
• 调整完成后运行SaveECOToDB宏，即可将修改后的数据同步回底层数据库
• 代码自动规避了整表选中的问题，完全基于数据边界匹配范围，不会出现内存溢出问题

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