求一个EXCEL的函数或者VBA代码,目的是一个“工作簿”内的多张“工作表”的A列可以有防重复功能

比如在SHEET1中的A列里有 1,2,3等数据
SHEET2中的A列里有 4,5,6等数据
于是我在SHEET3、SHEET4....中的A列输入1,2,3,4,5,6等数据时会有提示重复
也就是说,整个工作簿内任何一个A列的数据都不会重复

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 1 Then
For Each st In ActiveWorkbook.Sheets
n = n + Application.WorksheetFunction.CountIf(st.Columns("A"), Range("A" & Target.Row))
Next st
If n >= 2 Then Target.Clear
End If
End Sub

按alt+f11,双击左侧的thisworkbook(很关键,必须添加在workbook中,添加到任意一个sheet里都不行) 添加以上代码即可。
作用是,如果A列有重复,则自动清除刚输入的数据。
如果要改成弹出对话框提示,那么把倒数第三行的Target.Clear改成 msgbox "有重复"即可追问

感谢您的帮助,的确有效果,但是还有一点小问题
就是在多个数据批量复制进去的时候会失效
比如SHEET1的A列中有 A、B、C、D,但是当我从另外一个”工组簿“复制E、A、B、C、D进入SHEET1中时,就不会自动去重了。我希望得到的是可以自动删掉重复的数据而能保留其中不重复的数据,得到最终的结果A、B、C、D、E

追答

正在修改,这样子,把问题一步到位吧,有没有可能复制过去的数据不仅仅是A列,比如还包括ABC三列这样,然后需要把重复的这一整行数据都删除掉?
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 1 Then
For rag = Target.Rows.Count To 1 Step -1
For Each st In ActiveWorkbook.Sheets
n = n + Application.WorksheetFunction.CountIf(st.Columns("A"), Range("A" & (Target.Row + rag - 1)))
Next st
If n >= 2 Then Range("A" & (Target.Row + rag - 1)).Clear
Next rag
End If
End Sub
这样就是仅仅清除A列重复的数据,对复制有效,如果要改成删除A重复所在的整行,那么就把倒数第三行then后边的部分改成 rows(Target.Row + rag - 1).delete

追问

多谢兄弟你费心了,感激不尽
使用了一下之后发现有2个问题
1.比如SHEET1中A列有A、B、C、D 我单独从其他地方复制进去一组数据:A、B、C、D、E、F、G 发现除了A、B、C、D 会被删除以外,E和F也会消失,只剩G(既只剩最后一个数据)
2.我把原本存在的内容删除掉后(选定DELETE),然后在想输入删掉的内容就加不进去了,不知可否解决

追答

我疏忽了,判断重复的n忘记加一个重置语句了.改为下边这个即可
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 1 Then
For rag = Target.Rows.Count - 1 To 0 Step -1
n = 0
For Each st In ActiveWorkbook.Sheets
n = n + Application.WorksheetFunction.CountIf(st.Columns("A"), Range("A" & (Target.Row + rag)))
Next st
If n >= 2 Then Range("A" & (Target.Row + rag)).Clear
Next rag
End If
End Sub

至于输入删掉的内容,只要A列不重复,不会加不进去的呀.

温馨提示:答案为网友推荐,仅供参考

相关了解……

你可能感兴趣的内容

本站内容来自于网友发表,不代表本站立场,仅表示其个人看法,不对其真实性、正确性、有效性作任何的担保
相关事宜请发邮件给我们
© 非常风气网