VBA宏添加车辆数据时nextBlankRow逻辑失效、重复校验异常问题

问题根因说明 #

你原来的代码存在两个核心逻辑错误：

1. 空白行计算规则错误：lastrow采用全表查找最后一行的逻辑，会被目标表格外其他列的内容干扰，导致下一个空白行的计算结果不符合预期。
2. 校验顺序错误：先写入数据再做重复校验，等于重复数据已经落库之后才做判断，就算触发提醒也只是清空刚写入的内容，无法从根源阻止重复数据录入，同时双层循环的校验逻辑冗余，容易出现遍历遗漏。

修复后完整代码 #

Sub addData()
    Dim targetLastRow As Long, nextBlankRow As Long
    Dim existRow As Range
    
    ' 校验必填项是否为空
    If Range("E2") = "" Then
        MsgBox "Wählen Sie ein KFZ aus!"
        Range("E2").Select
        Exit Sub
    End If
    
    ' 仅统计C列从第13行开始的最后一个非空行，计算下一个空白写入行
    targetLastRow = Cells(Rows.Count, "C").End(xlUp).Row
    nextBlankRow = IIf(targetLastRow < 13, 13, targetLastRow + 1)
    
    ' 提前校验重复：比对C、D列值与录入的E2、E3值是否一致
    For Each existRow In Range("C13:C" & targetLastRow)
        If existRow.Value = Range("E2").Value And existRow.Offset(0, 1).Value = Range("E3").Value Then
            MsgBox "Datensatz schon vorhanden!"
            Exit Sub ' 匹配到重复直接终止流程，不执行写入
        End If
    Next
    
    ' 校验通过后写入新行数据
    Cells(nextBlankRow, 3) = Range("E2")
    Cells(nextBlankRow, 4) = Range("E3")
    Cells(nextBlankRow, 5) = Range("E4")
    Cells(nextBlankRow, 6) = Range("E5")
    Cells(nextBlankRow, 7) = Range("E6")
    Cells(nextBlankRow, 8) = Range("E7")
    Cells(nextBlankRow, 9) = Range("E8")
End Sub

功能适配说明 #

• 如果你的重复判断规则不是比对C、D两列，可以自行修改If判断里的匹配字段即可。
• 如果需要录入完成后自动清空E2-E8的录入内容，可以在代码最后加上Range("E2:E8").ClearContents。

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