VBA实现同一行两列匹配校验 避免同日期同车辆数据重复录入

方案1：CountIfs快速判断是否存在重复 #

最简洁的实现方式，适合仅需要判断是否存在重复的场景：

Dim wsData As Worksheet
Dim targetDate As Date
Dim targetVehicle As String
Dim matchCount As Long

' 初始化对象与变量，控件名称请替换为你实际的窗体控件名
Set wsData = ThisWorkbook.Worksheets("Data")
targetDate = CDate(Me.txtDate.Value)
targetVehicle = Trim(Me.txtVehicleType.Value)

' 双字段匹配计数
matchCount = WorksheetFunction.CountIfs( _
    wsData.Range("A:A"), targetDate, _
    wsData.Range("B:B"), targetVehicle _
)

如果matchCount > 0说明存在同一日期同一车型的重复记录。

方案2：Find匹配+字段校验（可获取匹配行号） #

兼容你原有单字段Find的逻辑，同时支持获取重复记录所在行号，方便后续覆盖操作：

Dim wsData As Worksheet
Dim targetDate As Date
Dim targetVehicle As String
Dim foundCell As Range
Dim firstAddress As String
Dim recordRow As Long

Set wsData = ThisWorkbook.Worksheets("Data")
targetDate = CDate(Me.txtDate.Value)
targetVehicle = Trim(Me.txtVehicleType.Value)
recordRow = 0

' 先查找所有日期匹配的行，再校验车型是否匹配
Set foundCell = wsData.Range("A:A").Find(What:=targetDate, LookAt:=xlWhole, LookIn:=xlValues)
If Not foundCell Is Nothing Then
    firstAddress = foundCell.Address
    Do
        ' 校验当前行车型是否匹配
        If wsData.Cells(foundCell.Row, "B").Value = targetVehicle Then
            recordRow = foundCell.Row
            Exit Do
        End If
        Set foundCell = wsData.Range("A:A").FindNext(foundCell)
    Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
End If

' 后续逻辑和你原有单字段校验逻辑对齐即可
If recordRow > 0 Then
    answer = MsgBox("数据已存在，是否覆盖原有记录？", vbCritical + vbYesNo, "数据重复")
    If answer = vbYes Then
        ' 覆盖对应行数据，列索引请替换为你实际的存储列
        wsData.Cells(recordRow, "C") = Me.txtRunTime.Value ' 运行时长
        wsData.Cells(recordRow, "D") = Me.txtCost.Value ' 费用
        MsgBox "原有记录已覆盖", vbInformation, "操作完成"
        Exit Sub
    Else
        MsgBox "已取消新增", vbInformation, "操作完成"
        Exit Sub
    End If
End If

' 无重复则追加新行
Dim targetRow As Long
targetRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row + 1
wsData.Cells(targetRow, "A") = targetDate
wsData.Cells(targetRow, "B") = targetVehicle
wsData.Cells(targetRow, "C") = Me.txtRunTime.Value
wsData.Cells(targetRow, "D") = Me.txtCost.Value
MsgBox "新记录已添加", vbInformation, "操作完成"

方案3：数组遍历（适合大数据量场景） #

如果Data表数据量超过1万行，建议使用数组遍历方案，执行效率远高于逐行操作单元格：

Dim wsData As Worksheet
Dim targetDate As Date
Dim targetVehicle As String
Dim dataArr As Variant
Dim i As Long
Dim recordRow As Long

Set wsData = ThisWorkbook.Worksheets("Data")
targetDate = CDate(Me.txtDate.Value)
targetVehicle = Trim(Me.txtVehicleType.Value)
recordRow = 0

' 将整表数据读入内存数组
dataArr = wsData.UsedRange.Value
For i = 1 To UBound(dataArr, 1)
    ' 双字段匹配判断
    If dataArr(i, 1) = targetDate And dataArr(i, 2) = targetVehicle Then
        recordRow = i
        Exit For
    End If
Next i

' 后续覆盖/新增逻辑和方案2一致

注意：代码中的列索引、控件名称请根据你实际的表结构和窗体控件名修改。

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