Question

我使用以下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

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

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内的情况。

{{1}}

Answer 2

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

一旦您发现在“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

VBA在列和列表行号中找到重复项？

2 个答案: