VBA在列和列表行号中找到重复吗?

I am using the following VBA code to search a column for duplicate values. If found then i want to populate cell Q1 with a hyperlink to that row number.

我使用下面的VBA代码来搜索一列重复值。如果找到，那么我希望使用到该行号的超链接填充单元格Q1。

Here's what i have:

这就是我有:

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

Please can someone show me how to get the row number of the duplicate value?

请谁来告诉我如何得到重复值的行号?

2 个解决方案

#1

I would just use the Range.Find method to accomplish both checking for duplicates and getting the Address. You may want to consider clearing the hyperlink and the cell at some point in time. You could check to see if there are any duplicates, and clear if that is the case; or you could check for multiple duplicates, and output them in sequential cells. All kinds of things.

我只要用范围。找到方法来完成检查副本和获取地址。您可能需要考虑在某个时候清除超链接和单元格。你可以检查是否有任何重复，如果是这样的话就清楚了;或者您可以检查多个副本，并将它们输出到顺序单元格中。各种各样的东西。

EDIT You also need to decide how to handle the situation in which Target is a multicell range. Consider the situation where Target is entirely within Column O, and where it is not.

编辑您还需要决定如何处理目标是一个多单元范围的情况。考虑目标完全在O列内，而不在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

#2

Try the code below, it's not as simple as I would like it to be, but it works.

试试下面的代码，它并不像我希望的那样简单，但它确实有效。

Once you find that the current value entered in column "O" has a duplicate, I am using the Find method to find the next match.

一旦发现在“O”列中输入的当前值具有副本，我就使用find方法查找下一个匹配项。

Code

代码

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

#1