VBA是否在列和列表行编号中查找重复项？

我正在使用以下VBA代码搜索列中的重复值。 如果找到了，我想用一个指向该行号的超链接填充单元格Q1

以下是我所拥有的：

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Column = 15 And Len(Target.Value) > 0 Then             
        If Evaluate("Countif(O:O," & Target.Address & ")") > 1 Then
            Range("P1").Value = "DUPLICATE ENTRY EXISTS"            
            Range("Q1").Formula= "=HYPERLINK()"                     
        End If             
    End If

End Sub

---

有人能告诉我如何获得重复值的行号吗？

试试下面的代码，它并不像我希望的那么简单，但它可以工作

一旦您发现列“O”中输入的当前值有重复项，我将使用

find

方法查找下一个匹配项

代码

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False
    If Target.Column = 15 And Len(Target.Value) > 0 Then

        If Evaluate("Countif(O:O," & Target.Address & ")") > 1 Then
            Range("P1").Value = "DUPLICATE ENTRY EXISTS"

            Dim RowDup As Long
            Dim FindRng As Range
            Dim LastRow As Long

            LastRow = Cells(Rows.Count, Target.Column).End(xlUp).Row ' get last row with data in Column "O"

            If Target.Row = 1 Then
                Set FindRng = Range(Cells(Target.Row + 1, Target.Column), Cells(LastRow, Target.Column))
            Else ' define a search range, substract target cell from active range in column "O"
                Set FindRng = Application.Union(Range(Cells(1, Target.Column), Cells(Target.Row - 1, Target.Column)), Range(Cells(Target.Row + 1, Target.Column), Cells(LastRow, Target.Column)))
            End If

            ' find thr row number in the column O (except Target cell)
            RowDup = FindRng.Find(What:=Target.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row

            ' get the hyperlink to the cell where the first dupliacte exists
            Range("Q1").Formula = "=HYPERLINK(" & Range(Cells(RowDup, Target.Column), Cells(RowDup, Target.Column)).Address & ")"
        End If
    End If
    Application.EnableEvents = True

End Sub

---

我只需要使用

Range.Find

方法来完成重复项的检查和地址的获取。您可能需要考虑在某个时间点清除超链接和单元格。您可以检查是否存在任何重复项，并确定是否存在重复项；或者，您可以检查多个副本，并在连续单元格中输出它们。各种各样的东西

编辑您还需要决定如何处理

目标

为多小区范围的情况。考虑“<代码>目标< /代码>的情况完全在列<代码> o>代码>中，而不是在哪里。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim R As Range, C As Range
    Dim S As String

Set R = Columns(15)

If Not Intersect(Target, R) Is Nothing Then
    Application.EnableEvents = False
    Set C = R.Find(what:=Target.Text, after:=Target, LookIn:=xlValues, _
        lookat:=xlWhole, MatchCase:=False)
    If C.Address <> Target.Address Then
        S = C.Address(external:=True)
        S = Mid(S, InStr(S, "]") + 1)
        Range("q1").Hyperlinks.Delete
        Range("Q1").Hyperlinks.Add Anchor:=Range("q1"), _
            Address:="", SubAddress:=S, _
            TextToDisplay:=C.Address, ScreenTip:="Duplicate Entry"

    Else 'Clear Q1 if no duplicate
        Range("Q1").Clear
    End If
End If
Application.EnableEvents = True

End Sub

选项显式
私有子工作表_更改（ByVal目标作为范围）
变暗R为范围，C为范围
像线一样变暗
集合R=列（15）
如果不相交（目标，R）则为零
Application.EnableEvents=False
设置C=R.Find（what:=Target.Text，after:=Target，LookIn:=xlValues_
lookat:=xlother，MatchCase:=False）
如果C.地址目标.地址，则
S=C.地址（外部：=True）
S=Mid（S，仪表，“]”+1）
范围（“q1”）.Hyperlinks.Delete
范围（“Q1”）。超链接。添加锚定：=范围（“Q1”）_
地址：=“”，子地址：=S_
TextToDisplay:=C.地址，屏幕提示：=“重复条目”
如果没有重复项，则清除“Else”
范围（“Q1”）。清除
如果结束
如果结束
Application.EnableEvents=True
端接头

一个条目可以有多个重复项吗？很好，罗恩，我知道我以前的方法比我使用的“算法”更简洁below@ShaiRado谢谢我注意到我只是写了地址，而不是超链接。我会改变that@ShaiRado谢谢一般来说，在编写宏时，我更喜欢使用VBA，而不是将公式写回工作表（除非有特定原因在工作表上而不是在VBA中执行该操作）。在这里，我们根据工作表事件进行更改，因此似乎没有很好的理由将此作为公式进行更改。您还应该检查

C

是否为

Nothing

@user3598756我认为这没有必要。当您测试此功能时，您是如何设置工作表的，以使其成为一个问题的？