从用户表单输入填充excel列时如何防止重复？

我正在寻找一种方法来防止用户在excel列中添加重复条目。我找到了在excel中设置列的方法，但它不适用于userform输入

我曾在excel中尝试过数据验证设置，但当输入来自userform时，它们就不起作用了

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strTargetColumn As String
    Dim nTargetRow As Integer
    Dim nLastRow As Integer
    Dim strMsg As String

    strTargetColumn = Split(Target.Address(, False), "$")(0)
    nTargetRow = Split(Target.Address(, False), "$")(1)
    nLastRow = ActiveSheet.Range(strTargetColumn & ActiveSheet.Rows.Count).End(xlUp).Row

    For nRow = 1 To nLastRow
        If nRow <> nTargetRow Then
          If ActiveSheet.Range(strTargetColumn & nRow).Value = Target.Value Then
             strMsg = "The value has been entered in the same column!"
             MsgBox strMsg, vbExclamation + vbOKOnly, "Duplicate Values"
             Target.Select
             Exit For
          End If
       End If
    Next

End Sub

Private子工作表\u更改（ByVal目标作为范围）
将strTargetColumn设置为字符串
将行设置为整数
Dim nLastRow作为整数
作为字符串的Dim strMsg
strTargetColumn=Split（Target.Address（，False），“$”）（0）
nTargetRow=Split（Target.Address（，False），“$”）（1）
nLastRow=ActiveSheet.Range（strTargetColumn&ActiveSheet.Rows.Count）。End（xlUp）。Row
对于nRow=1到nLastRow
如果是nRow，那么
如果ActiveSheet.Range（strTargetColumn&nRow）.Value=Target.Value，则
strMsg=“该值已输入到同一列中！”
MsgBox strMsg，VBEQUOTION+vbOKOnly，“重复值”
目标。选择
退出
如果结束
如果结束
下一个
端接头

这是我在一次网络搜索中发现的一些代码，它弹出一个重复的输入到列中，但仍然允许它保留在列中

我想有一个弹出窗口告诉用户，他们已经添加了一个副本，不允许它进入细胞。这可能吗

---

在按钮的用户窗体单击事件中查看它。下面是为“几何体”按钮执行此操作的方法。您应该始终使用Option Explicit强制声明变量；您的代码意味着您不需要。对对象要明确-不要使用ActiveWorkbook、ActiveCell等

有很多方法可以改进这一点。这真的不是一个好办法。我提供这些是为了让你走上更好的轨道

'@Folder("VBAProject")
Option Explicit

Private Sub GeometryAddButton_Click()
    Dim theValueToAdd As Double
    theValueToAdd = CDbl(Me.theGeometryTextbox.Text) 'assumes the value is a double
    Dim theTargetWorkbook As Workbook
    Set theTargetWorkbook = ThisWorkbook 'assumes you want to use the book the form and code are in
    Dim theTargetWorksheet As Worksheet
    Set theTargetWorksheet = theTargetWorkbook.Worksheets("myDatabaseWorksheet") 'whatever teh name of your worksheet actually is
    With theTargetWorksheet
        Dim theGeometryColumn As Long
        theGeometryColumn = 1 'assumes the Geometry column is Column A (i.e. 1)
        Dim GeometryDataRange As Range
        Set GeometryDataRange = .Range(.Cells(1, theGeometryColumn), .Cells(.UsedRange.Rows.Count, theGeometryColumn)) 'the full range of cells in Geometry column
    End With
    Dim findExistingValue As Range
    Set findExistingValue = Nothing
    On Error Resume Next 'if the value isn't found the Find method will fail, but that is what we are going to test for
        Set findExistingValue = GeometryDataRange.Find(theValueToAdd, LookIn:=xlValues, lookat:=xlWhole)
    On Error GoTo 0
    If Not findExistingValue Is Nothing Then 'if the Find does not fail (i.e. findExistingValue is not nothing)
        'pop up the message that the value already exists
    Else
        'add the value to the list
    End If
End Sub

---

在从用户表单写入值之前，请在列上使用

Application.CountIf

。您必须将其添加到用户表单代码中，而不是

工作表\u Change

event.BigBen我将对此进行研究。我还在学习。ThanksGMalc，我会将其添加到Userform_initialize或我的add按钮中吗？对不起，我还是个初学者。如果你想给某个特定的人发送消息，只需要一个指针，在名字前面加上@符号。这样他们就会收到通知