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

2024-07-27 • 问答

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

我已经在excel中尝试了“数据验证”设置，但它们可以正常工作，但是当输入来自用户窗体时，它们却没有。

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(,"$")(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

这是我在网络搜索过程中发现的一些代码，弹出该代码时，已在该列中输入了重复项，但仍然允许它留在该列中。

我想让一个弹出窗口告诉用户他们添加了重复项，并且不允许它进入单元格。这可能吗？

在用户窗体的Click事件中查看它的按钮。以下是“几何”按钮的一种实现方法。您应该始终使用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

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

tianlibuaiwo 回答：从用户表单输入填充Excel列时，如何防止重复？

大家都在问