修复Client INFO联系信息导入Sold工作表的位置与删除异常

问题1：内容定位错误且持续追加 #

原因 #

当前代码依赖隐藏的Tracking工作表存储上次写入的行号，而非实时检测Sold工作表的实际空白行。如果Tracking表A1的初始值是27，就会直接写入28行，且每次点击都自动+1，完全忽略Sold表的真实空白位置。

修复 #

删掉所有和Tracking工作表相关的逻辑，改为实时获取Sold工作表C列的首个空白行（从第4行开始）：

' 实时获取Sold工作表C列首个空白行，确保至少从第4行开始
destRow = wsSold.Cells(wsSold.Rows.Count, "C").End(xlUp).Row + 1
If destRow < 4 Then destRow = 4

问题2：取消Accept状态时未删除Sold表对应内容 #

原因 #

代码仅处理了Accept激活时的复制逻辑，没有编写取消状态的删除逻辑，且缺少Client Info行与Sold行的关联标记，无法定位要删除的内容。

修复 #

1. 在Client Info工作表新增M列（命名为"Sold行号"），用来记录该行内容写入Sold表的行号，方便后续删除。
2. 修改Accept列（L列）的双击逻辑，增加取消状态时的删除步骤：

ElseIf Not Intersect(Target, Me.Range("L:L")) Is Nothing Then
    ' 读取当前行的Sold行号记录
    Dim soldRowNum As Variant
    soldRowNum = wsClientInfo.Cells(Target.Row, "M").Value
    
    If Target.Value = "Accepted" Then
        ' 取消Accept：删除Sold对应行，清空标记
        Target.Value = ""
        If IsNumeric(soldRowNum) Then
            wsSold.Rows(soldRowNum).Delete Shift:=xlUp
            wsClientInfo.Cells(Target.Row, "M").ClearContents
            ' 更新其他行的Sold行号（因为删除后行号会前移）
            Dim rng As Range
            For Each rng In wsClientInfo.Range("M2:M" & wsClientInfo.Cells(wsClientInfo.Rows.Count, "M").End(xlUp).Row)
                If IsNumeric(rng.Value) And rng.Value > soldRowNum Then
                    rng.Value = rng.Value - 1
                End If
            Next rng
        End If
    Else
        ' 激活Accept：复制内容到Sold，记录行号
        Target.Value = "Accepted"
        destRow = wsSold.Cells(wsSold.Rows.Count, "C").End(xlUp).Row + 1
        If destRow < 4 Then destRow = 4
        
        Set srcRange = wsClientInfo.Range("C" & Target.Row & ":F" & Target.Row)
        Set destRange = wsSold.Range("C" & destRow & ":F" & destRow)
        destRange.Value = srcRange.Value
        
        wsClientInfo.Cells(Target.Row, "M").Value = destRow
    End If
    Cancel = True

完整修复后的代码 #

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim wsClientInfo As Worksheet
    Dim wsSold As Worksheet
    Dim destRow As Long
    Dim srcRange As Range
    Dim destRange As Range
    Dim soldRowNum As Variant
    Dim rng As Range

    Set wsClientInfo = ThisWorkbook.Sheets("Client Info")
    Set wsSold = ThisWorkbook.Sheets("Sold")

    ' 处理Contacted列（K列）
    If Not Intersect(Target, Me.Range("K:K")) Is Nothing Then
        If Target.Value = "Contacted" Then
            Target.Value = ""
            Target.Interior.ColorIndex = xlNone
        Else
            Target.Value = "Contacted"
            Target.Interior.Color = RGB(0, 255, 0)
        End If
        Cancel = True

    ' 处理Accepted列（L列）
    ElseIf Not Intersect(Target, Me.Range("L:L")) Is Nothing Then
        soldRowNum = wsClientInfo.Cells(Target.Row, "M").Value
        
        If Target.Value = "Accepted" Then
            ' 取消Accept状态：删除Sold对应行并更新标记
            Target.Value = ""
            If IsNumeric(soldRowNum) Then
                wsSold.Rows(soldRowNum).Delete Shift:=xlUp
                wsClientInfo.Cells(Target.Row, "M").ClearContents
                ' 同步更新其他行的Sold行号
                For Each rng In wsClientInfo.Range("M2:M" & wsClientInfo.Cells(wsClientInfo.Rows.Count, "M").End(xlUp).Row)
                    If IsNumeric(rng.Value) And rng.Value > soldRowNum Then
                        rng.Value = rng.Value - 1
                    End If
                Next rng
            End If
        Else
            ' 激活Accept状态：复制内容到Sold并记录行号
            Target.Value = "Accepted"
            destRow = wsSold.Cells(wsSold.Rows.Count, "C").End(xlUp).Row + 1
            If destRow < 4 Then destRow = 4
            
            Set srcRange = wsClientInfo.Range("C" & Target.Row & ":F" & Target.Row)
            Set destRange = wsSold.Range("C" & destRow & ":F" & destRow)
            destRange.Value = srcRange.Value
            
            wsClientInfo.Cells(Target.Row, "M").Value = destRow
        End If
        Cancel = True
    End If
End Sub

内容的提问来源于stack exchange，提问作者RVM PS4