设备借还UserForm表单VBA问题：归还时误改所有同设备号的归还日期

你的核心问题是代码会遍历所有匹配设备号的行并修改E列，而非仅更新**首个未归还（E列为空）**的记录。以下是修正后的代码和关键调整说明：

关键修改点 #

• 新增E列空值判断：匹配设备号的同时，检查对应行E列是否为空，确保只处理未归还的记录
• 找到目标行后立即退出循环：避免继续遍历修改其他同设备号的行
• 移除冗余的Select操作：直接引用工作表和单元格，提升代码效率和稳定性
• 简化输入校验逻辑：更简洁的空值判断方式

修正后的VBA代码 #

Private Sub CommandButton1_Click()
    Dim targetDevice As String
    Dim inventorySheet As Worksheet
    Dim rng As Range
    Dim rcell As Range
    
    ' 初始化工作表对象，避免重复切换工作表
    Set inventorySheet = ThisWorkbook.Sheets("Inventory")
    
    ' 输入校验：检查设备编号是否为空
    If Trim(Me.ComboBox1.Value) = "" Then
        MsgBox "操作需输入设备编号，请填写后重试"
        Exit Sub
    End If
    targetDevice = Trim(Me.ComboBox1.Value)
    
    ' 解锁工作表
    inventorySheet.Unprotect
    
    ' 仅遍历A列已使用的单元格（而非整列，提升运行效率）
    Set rng = inventorySheet.Range("A1:A" & inventorySheet.Cells(inventorySheet.Rows.Count, "A").End(xlUp).Row)
    For Each rcell In rng.Cells
        ' 匹配设备号 + 对应行E列为空（未归还状态）
        If rcell.Value = targetDevice And rcell.Offset(0, 4).Value = "" Then
            ' 设置归还日期并格式化
            With rcell.Offset(0, 4)
                .Value = Now()
                .NumberFormat = "dd/mm/yyyy"
            End With
            ' 找到第一个符合条件的记录后立即退出循环
            Exit For
        End If
    Next rcell
    
    ' 重新保护工作表
    inventorySheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
    ' 可选：提示操作完成
    MsgBox "归还记录已更新"
End Sub

额外优化说明 #

• 遍历范围限制为A列实际有数据的行，避免遍历整列的空单元格，大幅提升运行速度
• 使用With语句简化单元格格式设置的代码，更易维护
• 增加Trim()处理输入内容，避免因输入前后空格导致的设备号匹配失败

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