Question

VBA 判断数据重复

请问在A4到H4中输入客户信息，然后添加到信息储存区，但首先要判断信息储存区里是否有该客户信息，如果有则不添加，没有则添加代码怎么写？

添加客户信息的代码我写了，其他应该怎么添加？请发邮件：macmillan1204@qq.com





Answer 1

有个取巧的手段。
客户名称在b列
可用
if application.countif(range("b1:b65536"),cells(4,2))>1 then
msgbox "有重复"
exit sub
else
r=range("b65536").end(3).row+1
range("a4:h4").copy range("a"& r)
msgbox "添加成功"
end if

其他的你自己修改下

Answer 2

这个并不会

Answer 3

代码如下，如有问题请联系。邮件已发送。

Sub addCustom_Click()
    '添加客户信息
    
    '获取最后一条客户信息记录的所在的行标
    Dim RecordRow As Long
    RecordRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    '检查录入的客户信息书否与已有的重复
    '认为如果客户编号或者客户名称相同则为重复客户
    Dim CustomIDList, CustomNameList
    If RecordRow > 9 Then
        CustomIDList = Range(Cells(10, 1), Cells(RecordRow, 1))
        CustomNameList = Range(Cells(10, 2), Cells(RecordRow, 2))
        
        '用工作表函数在已有客户信息中查找新添加的客户，如果找到了，即有重复
        On Error Resume Next
        Dim m, n, k As Long, str As String
        With WorksheetFunction
            m = .Match(Cells(4, 1), CustomIDList, 0)
            n = .Match(Cells(4, 2), CustomNameList, 0)
            k = .Max(m, n)
        End With
        If k > 0 Then
            str = "客户编号或客户名称与已有客户重复，请核查。该条信息未添加！"
            str = str & Chr(10) & Chr(10) & "已有客户所在行为:" & k + 9
            MsgBox str
            Exit Sub
        Else
            On Error GoTo 0
            '如果不重复则添加记录
            Dim i As Byte
            RecordRow = RecordRow + 1
            For i = 1 To 8
                Cells(RecordRow, i) = Cells(4, i)
            Next i
            MsgBox "恭喜你，客户信息添加成功！", vbOKOnly
        End If
     End If
End Sub