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

Question

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

Answer 1

你这个需要用VBA代码来完成。
首先要把sheet1中A列的数据加入到一个动态数组中去，当你在sheet2等工作表A列中输入数据时，将此数据和数组中的元素进行比较，如果相同就给予提示，0.6秒后自动关闭消息，否则不提示。
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim MyArr()
x = 0
i = 2
Do Until Sheet1.Cells(i, 1).Value = ""
ReDim Preserve MyArr(x)
MyArr(x) = Sheet1.Cells(i, 1).Value
i = i + 1
x = x + 1
Loop
For n = 0 To UBound(MyArr)
If ActiveCell.Column <> 1 Then End
If Cells(ActiveCell.Row - 1, 1)= MyArr(n) Then
Dim WshShell As Object
Set WshShell = CreateObject("Wscript.Shell")
WshShell.popup "重复数据!", 0.6, "提示", 64
Set WshShell = Nothing
End If
Next
end sub
这段代码是放在thisworkbook下的，针对所有表格，SheetSelectionChange事件，触发此事件的动作为鼠标点击单元格或使用键盘上下移动选择单元格，所以当你完成输入后，用键盘向下移动即可,可以自动检查重复。
另：早上起来，又看了一下你的问题，原来是sheet1和sheet2两个表格中的A列，上面的代码只是对sheet1表格A列写的，有点不对，不过修改一下也简单，如果你看懂代码的话，自己也能修改的，不然再联系我。

Answer 2

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 1 Then
If Target.Count = 1 Then
For i = 1 To Sheets.Count
oldvalue = Target.Value
If i <> ActiveSheet.Index Then
cnt = Application.WorksheetFunction.CountIf(Sheets(i).Range("A:A"), oldvalue)
If cnt > 0 Then
Target.Interior.Color = 255
MsgBox ("与工作表" & Sheets(i).Name & "重复")
Exit For
Else
Target.Interior.Color = xlNone
End If
Else
cnt = Application.WorksheetFunction.CountIf(Sheets(i).Range("A:A"), oldvalue)
If cnt > 1 Then
Target.Interior.Color = 255
MsgBox ("与工作表" & Sheets(i).Name & "重复")
Exit For
Else
Target.Interior.Color = xlNone
End If
End If
Next i
End If
End If
End Sub

在你想输入数字的工作表的 WORK_CHANGE 里添加下列代码

Answer 3

你先用这个试试：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 1 And Sh.Name <> Sheet1.Name And Sh.Name <> Sheet2.Name And Trim(Target.Text) <> "" And Not ((Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(Sheet1.Rows.Count, 1)).Find(Target.Text) Is Nothing) And (Sheet2.Range(Sheet2.Cells(1, 1), Sheet2.Cells(Sheet2.Rows.Count, 1)).Find(Target.Text) Is Nothing)) Then
'MsgBox Target.Text
Target.Value2 = ""
End If
End Sub

Answer 4

修改也要预防吗？追问

修改没有关系

追答

Option Explicit
Dim Dic As Object, SelValue

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set Dic = Nothing
End Sub

Private Sub Workbook_Open()
Dim i%, j%
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To Sheets.Count
For j = 1 To Sheets(i).Cells(65536, 1).End(xlUp).Row()
Dic(Sheets(i).Cells(j, 1).Value) = ""
Next j
Next i
Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim WshShell As Object
Set WshShell = CreateObject("Wscript.Shell")

If Target.Column 1 Then Exit Sub
Application.EnableEvents = False
If Dic.exists(Target.Value) Then
Target = ""
WshShell.popup "重复数据!", 0.6, "提示", 64
Else
Dic.Remove (SelValue)
Dic(Target.Value) = ""
Dic("") = ""
End If
Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
SelValue = Target.Value
End Sub