VBA拆分输入FS号匹配行剪切到另一工作表运行无结果排查

现有代码核心问题 #

• 匹配类型不匹配：Split函数拆分得到的FS号是字符串类型，如果Database工作表B列的FS号以数字格式存储，Match函数无法识别匹配，会返回0，执行Rows(0).Cut属于无效操作，错误被On Error Resume Next静默吞掉，没有执行后续粘贴逻辑。
• 匹配结果未校验：循环中没有判断iRow是否为0就直接执行剪切操作，匹配失败时的无效操作会直接跳过，不会有任何提示。
• 多匹配场景错位：每次剪切成功后Database表的行会向上偏移，后续Match查找的行号是原表的位置，会出现匹配错位，导致后续匹配失败。
• 最终判断逻辑错误：最终只校验最后一次循环的iRow值，若最后一个FS号匹配失败，哪怕前面的FS号匹配成功也会弹出「无记录」提示。
• 冗余操作风险：频繁激活工作表、Select单元格的操作容易受工作表状态（比如隐藏、保护）影响，导致粘贴失败。

修正后的代码 #

Sub DeleteRecord()
    Dim iRow As Long
    Dim iSerial As String
    Dim Result() As String
    Dim i As Long
    Dim b As Long
    Dim wsDB As Worksheet, wsCleared As Worksheet, wsForm As Worksheet
    Dim matchVal As Variant
    Dim hasMatch As Boolean
    
    ' 提前定义工作表对象，避免重复调用
    Set wsDB = ThisWorkbook.Worksheets("Database")
    Set wsCleared = ThisWorkbook.Worksheets("Cleared")
    Set wsForm = ThisWorkbook.Worksheets("Form")
    hasMatch = False
    
    iSerial = Application.InputBox("Please enter FS Number to delete", "Delete", , , , , , 2)
    If iSerial = "False" Then Exit Sub ' 用户点击取消直接退出
    Result = Split(iSerial, ",")
    
    ' 倒序循环避免行上移导致的错位
    For i = UBound(Result()) To LBound(Result()) Step -1
        ' 转换格式和B列匹配，支持数字和字符串格式的FS号
        matchVal = Application.Match(Val(Trim(Result(i))), wsDB.Range("B:B"), 0)
        If Not IsError(matchVal) Then
            iRow = CLng(matchVal)
            hasMatch = True
            ' 不需要激活选中，直接赋值移动
            b = wsCleared.Cells(wsCleared.Rows.Count, 2).End(xlUp).Row + 1
            wsDB.Rows(iRow).Copy wsCleared.Rows(b)
            wsDB.Rows(iRow).Delete ' 复制完成后删除原行，等价剪切效果
            wsCleared.Cells(b, 10).Value = Format(Now(), "DD-MM-YYYY HH:MM:SS")
        End If
    Next i
    
    If Not hasMatch Then
        MsgBox "No record found.", vbOKOnly + vbCritical, "No Record"
    End If
    
    ' 回到Form页面
    wsForm.Activate
    wsForm.Cells(1, 1).Select
End Sub

数据表样例 #

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