我正在尝试创建一个程序，以便它可以找到位于同一列中的每个重复项的最后一行索引并存储它们的值。例如，在图片中，John、trump、alice 和 sarah 姓名的最后一行索引应该分别给我 13、17、23、26。目前，我的代码只能识别重复项，所以我该怎么做才能找到每个重复项的最后一行索引，不仅适用于我展示的图片，而且适用于所有情况？
Sub Testing()
Dim mycell As Range, RANG As Range
With Sheets(1)
' Build a range (RANG) between cell F2 and the last cell in column F
Set RANG = Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
' For each cell (mycell) in this range (RANG)
For Each mycell In RANG
' If the count of mycell in RANG is greater than 1, then set the value of the cell 1 across to the right of mycell (i.e. column G) as "Duplicate Found"
If Application.WorksheetFunction.CountIf(RANG, mycell.Value) > 1 Then
'how do i find the last row index of each duplicate here?
Next mycell
End Sub
最佳答案
可以通过多种方式完成。在下面的代码(测试)中使用了字典对象。请添加工具 -> 引用 -> Microsoft Scripting Runtime。
Sub Testing()
Dim mycell As Range, RANG As Range, Dict As Dictionary, Mname As String, Rng As Range
Set Dict = New Dictionary
With Sheets(1)
' Build a range (RANG) between cell F2 and the last cell in column F
Set RANG = Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
' For each cell (mycell) in this range (RANG)
For Each mycell In RANG
Mname = mycell.Value
' If the count of mycell in RANG is greater than 1, then set the value of the cell 1 across to the right of mycell (i.e. column G) as "Duplicate Found"
If Application.WorksheetFunction.CountIf(RANG, mycell.Value) > 1 Then
If Dict.Count > 0 And Dict.Exists(Mname) Then
Dict(Mname) = mycell.Row()
Else
Dict.Add Mname, mycell.Row()
End If
End If
Next mycell
'Display result in debug window (Modify to your requirement)
Startrow = 2
For Each Key In Dict.Keys
Set Rng = Sheets(1).Range("A" & Startrow & ":A" & Dict(Key))
Startrow = Dict(Key) + 1
' Now may copy etc the range Rng
Debug.Print Key, Dict(Key), Rng.Address
Next
End Sub
修改代码以提供范围对象(从评论中理解)
关于excel - 如何找到同一列中每个重复项的最后一行索引？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/60860839/