我正在创建一个实时数据库，该数据库为进程添加时间戳。重复条目的时间戳未放在正确的行中

问：

[在此图像中，当输入相同的序列号时，当输入重复条目时，时间戳不会进入原始条目的行。我正在尝试解决这个问题。该代码确实按预期删除了重复的条目，但未将时间戳放在正确的位置。

这是当前代码。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim cell As Range
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' Define the range where you want to remove duplicates (Column A in this case)
    Set KeyCells = Range("A:A")
    
    ' Check if the change occurred in the specified range
    If Not Application.Intersect(KeyCells, Target) Is Nothing Then
        Application.EnableEvents = False
        On Error Resume Next
        For Each cell In KeyCells
            If Not IsEmpty(cell.Value) Then
                If Not dict.Exists(cell.Value) Then
                    dict(cell.Value) = cell.Row ' Store the row of the original entry
                Else
                    ' Clear contents only if the current row is not the same as the original
                    If cell.Row <> dict(cell.Value) Then
                        cell.ClearContents
                    End If
                End If
            End If
        Next cell
        On Error GoTo 0
        Application.EnableEvents = True
    End If
    
    ' Add timestamps in the same row
    Dim ws As Worksheet
    Dim rFound As Range
    
    ' Define the range where the serial numbers are located
    Dim serialNumberColumn As Integer
    serialNumberColumn = 1 ' Assuming serial numbers are in Column A, change if they are in a different column
    
    ' Set the range where the serial numbers exist (adjust "A1:A1000" to your actual range)
    Set KeyCells = Range("A1:A1000")
    
    If Not Application.Intersect(KeyCells, Target) Is Nothing Then
        ' Assuming serial numbers are unique and in column A
        Set rFound = Columns(serialNumberColumn).Find(What:=Target.Value, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        If Not rFound Is Nothing Then
            ' Set the worksheet
            Set ws = rFound.Worksheet
            ' Find the next empty cell after the last non-empty cell in the row from W to AE (Column 23 to 31)
            Dim nextEmptyColumn As Integer
            nextEmptyColumn = GetNextEmptyColumn(ws.Cells(rFound.Row, 23).Resize(, 9))
            ' If we found an empty column, we set the timestamp
            If nextEmptyColumn <> 0 Then
                Application.EnableEvents = False
                ws.Cells(rFound.Row, nextEmptyColumn).Value = Now
                Application.EnableEvents = True
            End If
        End If
    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