ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
EH云课堂-专业的职场技能充电站 限时送,魔方网表将Excel变在线系统 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 ExcelHome出品 - VBA代码宝免费下载 13门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 179|回复: 14

[求助] 如何限制输入保存重复的数据?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-1-10 17:25 | 显示全部楼层 |阅读模式
有份表格,从表二录入客户信息并保存至表三,表一为查询表三的客户情况及跟踪记录的录入保存,因重复的信息不符合客户甄别及可能导致跟踪记录的冲突,想实现在表二录入保存时,先检索表三已有的数据是否存在重复,若是重复则禁止保存并提示。请问代码该怎么添加,又添加在何处?

烦请高手赐教!谢谢!

客户资料管理.zip

169.27 KB, 下载次数: 3

TA的精华主题

TA的得分主题

发表于 2019-1-10 18:40 | 显示全部楼层
建议用字典尝试解决哦

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-10 18:52 | 显示全部楼层
不知道为什么 发表于 2019-1-10 18:40
建议用字典尝试解决哦

本人初学者,严格来说还没入门,现有代码核心都是网友提供解决的,惭愧……

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-10 23:32 | 显示全部楼层
从坛里借鉴了其他网友的案例,该段代码在测试表格里,对A列的重复数据能起到阻止输入的作用,我将之放在表格三对应的sheet3的代码窗口中,为何不起作用??求指点

ption Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Column <> 1 Or .Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Range("e:e"), .Value) > 1 Then
            .Select
            MsgBox "不能输入重复的数据!", 64
            Application.EnableEvents = False
            .Value = ""
            Application.EnableEvents = True
        End If
    End With
End Sub

TA的精华主题

TA的得分主题

发表于 2019-1-11 09:20 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-11 16:20 | 显示全部楼层
MOY838840554 发表于 2019-1-11 09:20
除序号列以外的其他列全部一样才算重复?

哎呀,我犯糊涂了。列数没改。现在新的问题是,我要如何才能实现表格二输入数据发现表三e列数据重复时则表二所有输入数据禁止复制保存?

TA的精华主题

TA的得分主题

发表于 2019-1-11 18:05 | 显示全部楼层
arno61361 发表于 2019-1-11 16:20
哎呀,我犯糊涂了。列数没改。现在新的问题是,我要如何才能实现表格二输入数据发现表三e列数据重复时则 ...

请参考
Sub auto复制()
    If Len(Range("e2")) = 0 Then MsgBox "数据不完整!", 64: Exit Sub
    With Sheet3
        If Application.CountIf(.Range("A:A"), Range("e2")) > 1 Then MsgBox "数据重复!", 64: Exit Sub
        mr = .Range("a65536").End(xlUp).Row + 1
'        .Range("a" & mr) = mr - 1
        .Range("a" & mr) = Range("e2")
        .Range("b" & mr) = Range("c2")
        .Range("c" & mr) = Range("i2")
        .Range("d" & mr) = Range("c3")
        .Range("e" & mr) = Range("c4")
        .Range("f" & mr) = Range("c5")
        .Range("g" & mr) = Range("e3")
        .Range("h" & mr) = Range("g3")
        .Range("i" & mr) = Range("i3")
        .Range("j" & mr) = Range("g4")
        .Range("k" & mr) = Range("i4")
        .Range("l" & mr) = Range("e4")
        .Range("m" & mr) = Range("i5")
        .Range("n" & mr) = Range("e5")
        .Range("o" & mr) = Range("g5")
        .Range("p" & mr) = Range("c6")
        .Range("q" & mr) = Range("i6")
        .Range("r" & mr) = Range("g6")
        .Range("s" & mr) = Range("e6")
        .Range("t" & mr) = Range("c7")
        .Range("u" & mr) = Range("d7")
        .Range("v" & mr) = Range("f7")
        .Range("w" & mr) = Range("i7")
        .Range("x" & mr) = Range("c8")
        .Range("y" & mr) = Range("d8")
        .Range("z" & mr) = Range("f8")
        .Range("aa" & mr) = Range("i8")
        .Range("ab" & mr) = Range("c9")
        .Range("ac" & mr) = Range("e9")
        .Range("ad" & mr) = Range("g9")
        .Range("ae" & mr) = Range("h9")
        .Range("af" & mr) = Range("c10")
        .Range("ag" & mr) = Range("d10")
        .Range("ah" & mr) = Range("g10")
        .Range("ai" & mr) = Range("i10")
        .Range("aj" & mr) = Range("c11")
        .Range("ak" & mr) = Range("g11")
        .Range("al" & mr) = Range("c12")
        .Range("am" & mr) = Range("e12")
    End With
    Range("C2:C12") = ""
    Range("e3:e12") = ""
    Range("g3:g12") = ""
    Range("i2:i12") = ""
    Range("d7:f8") = ""
    Range("h9") = ""
    Range("d10") = ""
    MsgBox "成功录入"
End Sub

TA的精华主题

TA的得分主题

发表于 2019-1-11 18:06 | 显示全部楼层
请看附件
客户资料管理.zip (167.21 KB, 下载次数: 3)

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-11 21:09 | 显示全部楼层
本帖最后由 arno61361 于 2019-1-11 21:21 编辑

谢谢您的帮助!但您给的方案不是我想要的。我要限制输入重复数据的是表二C4单元的客户联系电话,当表二输入点击保存时,程序检索表三“客户资料库”里的E列是否存在重复,若是已存在相同号码,则表二“客户资料卡”所填写的任何数据无法保存到表三。不过,您的“数据不完整”提示的思路非常好。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-1-11 21:52 | 显示全部楼层
请问以下代码如何解决发现“C4"输入的数据重复时,如何禁止整个表格所录入的所有数据到表三,即中止”C4”单元格重复检查代码后面的数据复制保存功能?
Sub auto复制()
    If Len(Range("c2")) = 0 Then MsgBox "数据不完整!", 64: Exit Sub
    With Sheet3
        If Application.CountIf(.Range("E:E"), Range("c4")) > 1 Then MsgBox "该号码已存在,请查询核实后再录入!", 64: Exit Sub
        mr = .Range("d65536").End(xlUp).Row + 1
        .Range("b" & mr) = Range("c2")
        .Range("c" & mr) = Range("i2")
        .Range("d" & mr) = Range("c3")
        .Range("e" & mr) = Range("c4")
        .Range("f" & mr) = Range("c5")
        .Range("g" & mr) = Range("e3")
        .Range("h" & mr) = Range("g3")
        .Range("i" & mr) = Range("i3")
        .Range("j" & mr) = Range("g4")
        .Range("k" & mr) = Range("i4")
        .Range("l" & mr) = Range("e4")
        .Range("m" & mr) = Range("i5")
        .Range("n" & mr) = Range("e5")
        .Range("o" & mr) = Range("g5")
        .Range("p" & mr) = Range("c6")
        .Range("q" & mr) = Range("i6")
        .Range("r" & mr) = Range("g6")
        .Range("s" & mr) = Range("e6")
        .Range("t" & mr) = Range("c7")
        .Range("u" & mr) = Range("d7")
        .Range("v" & mr) = Range("f7")
        .Range("w" & mr) = Range("i7")
        .Range("x" & mr) = Range("c8")
        .Range("y" & mr) = Range("d8")
        .Range("z" & mr) = Range("f8")
        .Range("aa" & mr) = Range("i8")
        .Range("ab" & mr) = Range("c9")
        .Range("ac" & mr) = Range("e9")
        .Range("ad" & mr) = Range("g9")
        .Range("ae" & mr) = Range("h9")
        .Range("af" & mr) = Range("c10")
        .Range("ag" & mr) = Range("d10")
        .Range("ah" & mr) = Range("g10")
        .Range("ai" & mr) = Range("i10")
        .Range("aj" & mr) = Range("c11")
        .Range("ak" & mr) = Range("g11")
        .Range("al" & mr) = Range("c12")
        .Range("am" & mr) = Range("e12")
        
    End With
    Range("C2:C12") = ""
    Range("e3:e12") = ""
    Range("i2:i12") = ""
    Range("g3:g12") = ""
    Range("d7:D8") = ""
    Range("f7:F8") = ""
    Range("h9") = ""
    Range("h11:h12") = ""
    Range("d10") = ""
    MsgBox "成功录入"
End Sub
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-1-24 20:52 , Processed in 0.102941 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表