Excel VBA 不使用.Select实现InputBox查找匹配行复制

原代码报错核心原因是依赖.Select/工作表激活的操作逻辑，一旦出现焦点偏移、未匹配到条码导致SelectCells为空对象时就会触发运行时错误，同时全单元格遍历的逻辑在万行数据下执行效率极低。以下是完全移除.Select方法的稳定实现代码：

Sub Scan()
    Dim sourceWs As Worksheet, targetWs As Worksheet
    Dim Barcode As String
    Dim matchRng As Range, cell As Range
    Dim nextPasteRow As Long
    Dim upcColumn As Long
    
    ' 配置参数：UPC码所在列，默认是A列，可根据实际情况修改列号
    upcColumn = 1
    
    ' 直接绑定工作表对象，无需切换激活工作表
    Set sourceWs = ThisWorkbook.Worksheets("Sheet1")
    Set targetWs = ThisWorkbook.Worksheets("Sheet2")
    
    Do
        ' 接收扫码输入，点击取消直接退出循环
        Barcode = InputBox("Scan Barcode")
        If StrPtr(Barcode) = 0 Then Exit Do ' 检测用户点击取消按钮的操作
        If Len(Trim(Barcode)) = 0 Then GoTo NextScan ' 输入为空直接跳过本次扫描
        
        Set matchRng = Nothing
        ' 仅遍历UPC列的已使用单元格，比遍历全表效率提升数十倍
        For Each cell In sourceWs.UsedRange.Columns(upcColumn).Cells
            If CStr(cell.Value) = Barcode Then
                If matchRng Is Nothing Then
                    Set matchRng = cell
                Else
                    Set matchRng = Union(matchRng, cell)
                End If
            End If
        Next
        
        ' 找到匹配项才执行复制，无匹配直接跳过
        If Not matchRng Is Nothing Then
            ' 定位目标表下一个可粘贴的空行
            nextPasteRow = targetWs.Cells(targetWs.Rows.Count, upcColumn).End(xlUp).Row + 1
            ' 直接复制整行到目标位置，无需选中单元格、切换工作表
            matchRng.EntireRow.Copy Destination:=targetWs.Cells(nextPasteRow, 1)
        End If
        
NextScan:
    Loop
End Sub

核心改动点 #

• 完全移除所有.Select、Selection、工作表激活切换逻辑，所有单元格操作直接通过工作表对象调用，从根源规避Select类偶发报错
• 增加输入状态检测：识别用户点击InputBox「取消」按钮的操作，正常退出循环不会抛出类型不匹配错误
• 增加空对象判断：未匹配到对应条码时直接跳过后续复制逻辑，不会出现空对象调用的运行时错误
• 优化查找效率：不再遍历整个工作表的所有单元格，仅扫描UPC码所在列的有效数据行，万行数据场景下查找速度提升明显
• 修正变量类型：将条码变量从Double改为String，避免长UPC码精度丢失、前导零丢失导致的匹配失败问题
• 修复粘贴逻辑：自动定位目标工作表的首个空行追加数据，不会覆盖Sheet2中已存在的历史数据
• 支持同条码多行匹配：如果一个UPC对应多行数据，会一次性全部复制到目标表

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