VBA查找列和列表行中的重复项？

我正在使用下面的VBA代码来search列的重复值。 如果find，那么我想填充单元格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 

请有人可以告诉我如何获得重复值的行号？

Answer 1

我只是使用Range.Find方法来完成重复检查和获取地址。 您可能需要考虑在某个时间点清除超链接和单元格。 你可以检查是否有重复，并明确是否是这种情况; 或者你可以检查多个重复项，并将它们输出到顺序单元格中。 各种事情。

编辑你还需要决定如何处理Target是多单元范围的情况。 考虑一下Target完全在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 

Answer 2

尝试下面的代码，这不是我想要的那么简单，但它的工作原理。

一旦你发现列“O”中input的当前值有重复，我使用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