Excel VBA实时数据库：重复序列号时间戳录入位置错误修复求助

问题根源 #

你的代码核心问题在于逻辑顺序错位：

1. 先清空了重复的Target单元格，导致后续查找时间戳时，Target.Value已经为空，无法定位到原始条目行。
2. 去重时已经用字典存储了每个序列号的原始行，但时间戳部分没有复用这个数据，反而重新执行Find，既冗余又容易出错。

修复后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim cell As Range
    Dim dict As Object
    Dim inputValue As Variant
    Dim originalRow As Long
    
    Set dict = CreateObject("Scripting.Dictionary")
    ' 限定处理范围为A列已使用区域，避免整列循环拖慢速度
    Set KeyCells = Me.Range("A1", Me.Cells(Me.Rows.Count, "A").End(xlUp))
    
    If Not Application.Intersect(KeyCells, Target) Is Nothing Then
        Application.EnableEvents = False
        On Error Resume Next
        
        ' 先记录当前输入值，防止后续清空Target后丢失数据
        inputValue = Target.Value
        If IsEmpty(inputValue) Then
            Application.EnableEvents = True
            Exit Sub
        End If
        
        ' 构建字典：存储每个唯一序列号对应的原始行号
        For Each cell In KeyCells
            If Not IsEmpty(cell.Value) Then
                If Not dict.Exists(cell.Value) Then
                    dict(cell.Value) = cell.Row
                End If
            End If
        Next cell
        
        ' 判断当前输入是否为重复条目
        If dict(inputValue) <> Target.Row Then
            ' 清空重复条目
            Target.ClearContents
            ' 获取原始条目所在行
            originalRow = dict(inputValue)
            ' 给原始行添加时间戳
            AddTimestampToRow Me, originalRow
        Else
            ' 首次输入序列号，直接给当前行加时间戳
            AddTimestampToRow Me, Target.Row
        End If
        
        On Error GoTo 0
        Application.EnableEvents = True
    End If
End Sub

' 封装时间戳添加逻辑，代码更简洁易维护
Sub AddTimestampToRow(ws As Worksheet, rowNum As Long)
    Dim nextEmptyColumn As Integer
    ' 查找W到AE列（列号23-31）的第一个空单元格
    nextEmptyColumn = GetNextEmptyColumn(ws.Cells(rowNum, 23).Resize(, 9))
    If nextEmptyColumn <> 0 Then
        ws.Cells(rowNum, nextEmptyColumn).Value = Now
    End If
End Sub

Function GetNextEmptyColumn(rng As Range) As Integer
    Dim cell As Range
    GetNextEmptyColumn = 0
    For Each cell In rng
        If IsEmpty(cell.Value) Then
            GetNextEmptyColumn = cell.Column
            Exit For
        End If
    Next cell
End Function

关键修改说明 #

1. 提前记录输入值：在清空重复单元格前先把输入的序列号存下来，确保后续能正确找到原始行。
2. 复用字典数据：直接用去重时构建的字典获取原始行号，无需再次执行查找操作，避免逻辑错误。
3. 优化处理范围：把整列循环改成A列已使用区域，提升代码运行效率。
4. 封装逻辑：把添加时间戳的代码抽成独立子程序，便于后续修改维护。
5. 覆盖首次输入场景：新增首次输入序列号时自动添加时间戳的逻辑（如果不需要可以删掉Else分支）。

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