如何实现Excel单元格仅扫码枪更新及超时自动停止编辑？

看了你之前尝试的代码只统计按键次数，确实没法实现计时和扫码控制的需求，我给你整理了针对这两个问题的完整可行方案：

一、实现单元格超时未编辑自动停止 #

要实现这个功能，我们需要结合工作表选中事件记录编辑开始时间，再用定时任务检查是否超时，具体步骤如下：

1. 首先在目标工作表的模块顶部声明全局变量，用来存储编辑开始时间和监控范围：

Dim editStartTime As Date
Dim targetEditRange As Range

2. 用Worksheet_SelectionChange事件记录用户选中目标单元格的时间，并启动定时检查：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' 指定需要监控超时的单元格范围，比如A1:A100
    Set targetEditRange = Me.Range("A1:A100")
    
    ' 仅处理目标范围内的单个单元格选中事件
    If Not Intersect(Target, targetEditRange) Is Nothing And Target.Cells.Count = 1 Then
        editStartTime = Now() ' 记录编辑开始时间
        ' 设置超时时间（这里设为10秒），到点触发检查宏
        Application.OnTime Now() + TimeValue("00:00:10"), "CheckEditTimeout"
    Else
        ' 如果选中其他单元格，取消未触发的定时任务
        On Error Resume Next
        Application.OnTime Now() + TimeValue("00:00:10"), "CheckEditTimeout", , False
        On Error GoTo 0
    End If
End Sub

3. 插入一个标准模块（不是工作表模块），编写超时检查的宏：

Sub CheckEditTimeout()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("你的工作表名称") ' 替换成实际工作表名
    
    ' 检查当前激活单元格是否在监控范围内且处于编辑状态
    If Not Intersect(ActiveCell, ws.targetEditRange) Is Nothing Then
        ' 计算已编辑时长（单位：秒）
        Dim elapsedTime As Double
        elapsedTime = DateDiff("s", ws.editStartTime, Now())
        
        ' 如果超过设定的10秒，自动结束编辑
        If elapsedTime >= 10 Then
            ' 发送回车保存输入，也可以用{ESC}取消编辑
            Application.SendKeys "{ENTER}"
            MsgBox "编辑超时，已自动保存当前输入", vbInformation
        End If
    End If
End Sub

二、实现单元格仅允许扫码枪输入，禁止手动输入 #

扫码枪的输入有个核心特点：输入速度极快（一般几百毫秒完成），且输入后自动触发回车，而手动输入不可能达到这个速度。我们可以利用这个差异来区分扫码和手动操作：

1. 在目标工作表模块顶部声明全局变量，记录单元格选中时间：

Dim cellSelectTime As Date

2. 用Worksheet_SelectionChange记录选中目标单元格的时间：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' 指定仅允许扫码的单元格范围
    Dim scanOnlyRange As Range
    Set scanOnlyRange = Me.Range("A1:A100")
    
    If Not Intersect(Target, scanOnlyRange) Is Nothing And Target.Cells.Count = 1 Then
        cellSelectTime = Now() ' 记录选中时间
    End If
End Sub

3. 用Worksheet_Change事件判断输入耗时，超过阈值则撤销手动输入：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim scanOnlyRange As Range
    Set scanOnlyRange = Me.Range("A1:A100")
    
    ' 只处理目标范围内的单元格变更
    If Not Intersect(Target, scanOnlyRange) Is Nothing Then
        Application.EnableEvents = False ' 防止触发循环事件
        
        ' 计算从选中到输入完成的耗时（单位：秒）
        Dim inputDuration As Double
        inputDuration = DateDiff("s", cellSelectTime, Now())
        
        ' 设置阈值：比如0.5秒，手动输入不可能这么快完成
        If inputDuration > 0.5 Then
            ' 撤销手动输入
            Application.Undo
            MsgBox "该单元格仅允许扫码枪输入，禁止手动编辑！", vbExclamation
        End If
        
        ' 额外拦截粘贴操作
        If Application.CutCopyMode = xlCopy Then
            Application.Undo
            MsgBox "禁止粘贴到该单元格！", vbExclamation
        End If
        
        Application.EnableEvents = True ' 恢复事件触发
    End If
End Sub

注意事项 #

• 请把代码中的"你的工作表名称"替换成实际的工作表名称
• 超时时间（10秒）和输入阈值（0.5秒）可以根据实际需求调整
• 宏必须启用才能生效，确保Excel的宏安全设置允许信任该工作簿

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