VBA-重复值（未使用 DV）

Question

第一次 post，长时间的堆栈冲浪。我有一个关于捕获用户在 sheet 中输入欺骗值的问题。我们无法使用数据验证，因为 cut/copy/paste 抛出数据验证并允许他们输入欺骗值。我最初使用的是这段代码：

Option Explicit

Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

'******problem when copying entire row and pasting into new row, enables user to paste dupe Box ID #******

'Defining variables in Mailroom
Dim WS As Worksheet, EvalRange As Range

'Range to check for duplicates
Set EvalRange = Worksheets("Mailroom").Range("Box_ID_Number")

'Checking if entered value is in the defined range; also if cell is empty exit macro
If Intersect(Target, EvalRange) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub

'If user enters dupe value in specified range then error message pops up and event is undone
If WorksheetFunction.CountIf(EvalRange, Target.Value) > 1 Then
    MsgBox Target.Value & " already appears as a Box ID Number. Please enter a unique ID."
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
End If

End Sub

该代码可以很好地防止用户在 "Box ID Number." 的列中输入重复值我遇到的问题是，如果用户要从一个列和另一个单元格中复制一个 Box ID 号从不同的列，他们能够粘贴 _SheetChange 未捕获的 Dupe 值。当我们第一次为此创建代码时，我们禁用了 cut/copy/paste 函数；然而，其他使用 sheet 的人显然仍然需要 sheet.

的其他部分的功能

有什么想法吗？

Answer 1

假设您的用户实际上一次只需要更改一个单元格，我认为以下内容应该可行（它只是您代码的底部）：

If Intersect(Target, EvalRange) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub

'Check if only one cell in "Box_ID_Number" is changed
If Intersect(Target, EvalRange).Count > 1 Then
    MsgBox "One cell at a once please."
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    Exit Sub
End If

If WorksheetFunction.CountIf(EvalRange, Intersect(Target, EvalRange)) > 1 Then
    MsgBox Target.Value & " already appears as a Box ID Number. Please enter a unique ID."
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
End If

我删除了 Or Target.Cells.Count > 1，在我的版本中您看到的是 CountIf(EvalRange, Intersect(Target, EvalRange))，而不是 CountIf(EvalRange, Target.Value)。如果 Intersect(Target, EvalRange)) 不是一个单元格，您将再次收到类型不匹配 (13) 错误。因此，为了防止它，我实施了您看到的额外检查。

Answer 2

@ZygD！用 Intersect(Target, EvalRange)

钉了它

完成的代码如下所示：

Option Explicit

Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    'Defining variables in Mailroom
    Dim WS As Worksheet, EvalRange As Range

    'Range to check for duplicates
    Set EvalRange = Worksheets("Mailroom").Range("Box_ID_Number")

    If Intersect(Target, EvalRange) Is Nothing Then Exit Sub
    If IsEmpty(Target) Then Exit Sub

    'Check if only one cell in Box_ID_Number is changed at a time
    If Intersect(Target, EvalRange).Count > 1 Then
        MsgBox "Unable to modify greater than 1 Box ID Number at a time.  Please select one Box ID Row."
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
     Exit Sub
    End If`

    'check for dupe value in Box ID Number Column; if copy and pasting entire row, dupe check still holds
    If WorksheetFunction.CountIf(EvalRange, Intersect(Target, EvalRange)) > 1 Then
        MsgBox Intersect(Target, EvalRange) & " already appears as a Box ID Number. Please enter a unique ID."
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
    End If

End Sub

VBA-重复值（未使用 DV）

VBA-duplicate value (not using DV)

excel

events

vba

excel-2010