0

I am using the code below to identify duplicates in a column and delete ALL duplicates if found. I have the exact same code in another workbook and it's working fine. However, I am receiving "Subscript out of range" error when I compile code below. The highlight is on "m = UBound(toDel2) to LBound(toDel2) Step -1. I have looked online for help, and have been trouble shooting for hours. Could someone provide assistance? 

    Dim toDel2(), m As Long
    Dim RNG2 As Range, Cell2 As Long
    Set RNG2 = Range("a1:a1000") 'set your range here

    For Cell2 = 1 To RNG2.Cells.Count
        If Application.CountIf(RNG2, RNG2(Cell2)) > 1 Then
            ReDim Preserve toDel2(m)
            toDel2(m) = RNG2(Cell2).Address
            m = m + 1
        End If
    Next
    For m = UBound(toDel2) To LBound(toDel2) Step -1
        Range(toDel2(m)).EntireRow.Delete
4

4 回答 4

1

当没有找到导致 toDel2 为空的重复项时会发生错误，因此您无法获取 UBound 或 LBound。

这将为您解决问题：

Sub Example()
    Dim toDel2(), m As Long
    Dim RNG2 As Range, Cell2 As Long
    Set RNG2 = Range("A1:A1000")    'set your range here

    For Cell2 = 1 To RNG2.Cells.Count
        If Application.CountIf(RNG2, RNG2(Cell2)) > 1 Then
            ReDim Preserve toDel2(m)
            toDel2(m) = RNG2(Cell2).Address
            m = m + 1
        End If
    Next

    On Error GoTo NO_DUPLICATES
    For m = UBound(toDel2) To LBound(toDel2) Step -1
        Range(toDel2(m)).EntireRow.Delete
    Next
    On Error GoTo 0
    Exit Sub

NO_DUPLICATES:
End Sub
于 2013-06-13T17:42:59.657 回答
0

在我看来，这个声明：

if Application.CountIf(RNG2, RNG2(Cell2)) > 1 Then

永远不会返回True，因此您toDel2 array的永远不会被完全声明。Subscript out of range在你的情况下说数组是空的，它没有成功 Redim'med。

于 2013-06-13T17:21:41.400 回答
0

如果事实证明没有要删除的行，您将在您提到的行中收到您提到的错误，因为在这种情况下toDel2将永远不会被重新调整。我的猜测是这就是正在发生的事情，因为m如果您的变量toDel()被重新调暗，则会导致问题，所以这永远不会发生。鉴于这m将是零开始，你应该有m=m+1之前ReDim

于 2013-06-13T17:12:16.010 回答
0

这条线是问题所在：

ReDim Preserve toDel2(m)

您m在此行之前没有设置任何内容，因此它仍然为 0。当您使用这种格式时ReDim，您是在告诉它分配m或归零数组中的项目。

于 2013-06-13T17:13:30.127 回答