Question

我想创建一个运行良好的代码，该代码在一系列单元格中搜索重复值，并在找到重复值时退出该过程。如果用户多次进行相同的输入，则潜在的动机是防止数据输入不止一次发生。如果没有重复值，Worksheet1中提供的数据将被复制到Worksheet2。这就是为什么我不选择条件格式作为重复值的可能解决方案。

代码似乎没有捕获范围“（Range（”A：B“））”，其中重复值可能会发生，因为它在“如果rngduplicates（i）。地址处抛出”下标超出范围“错误。＆lt;＆gt; rngcell.Address然后“部分。

请找一下我一直在修补的代码。非常感谢您的帮助。

Sub attitude()

Workbooks("wbname").Activate

Dim EmptyRow As Long: EmptyRow = Application.WorksheetFunction.Count(Range("A:A")) + 1
Dim rng As Range
Dim i As Integer
Dim rngduplicates() As Range
Dim rngcell As Range
Dim rngCheck As Range

Set rngCheck = Worksheets("WK2").Range("A:B")

With Sheets("WK1")

  Set rng = .Range("B1:B2, B4:B11")
  Set rng = Union(.Range("B1:B2"), .Range("B4:B11"))

  For Each rngcell In rngCheck.Cells

    Debug.Print rngcell.Address

    If Not IsEmpty(rngcell.Value) Then
      ReDim rngduplicates(0 To 0)
      i = 0
      Set rngduplicates(i) = rngCheck.Find(What:=rngcell.Value, After:=rngcell, LookIn:=xlValues, _
      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
      i = i + 1
      If rngduplicates(i).Address <> rngcell.Address Then
        MsgBox ("You have already evaluated this agent. Please evaluate the next one")
        Exit Sub
      Else
        rng.Copy
        Sheets("WK2").Cells(EmptyRow + 1, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        Application.CutCopyMode = False
      End If
    End If

  Next rngcell

End With

Set rng = Nothing

End Sub

在进行新数据输入之前检查工作表上的重复值

0 个答案: