删除重复的可见行

Deleting Duplicate Visible Rows

我正在尝试使用以下 VBA 代码来做两件事。

  1. 计算过滤后的工作表中唯一可见行的数量。
  2. 删除重复行

到目前为止:

Function UniqueVisible(MyRange As Range) As Integer


    Dim ws As Worksheet
    Set ws = Worksheets(1)

    Dim R As Range
    Dim V() As String
    ReDim V(0 To MyRange.Count) As String


    For Each R In MyRange
        If (R.EntireRow.Hidden = False) Then
            For Index = 0 To UniqueVisible
                If (V(Index) = R.Value) Then
                    R.Delete
                    Exit For
                End If

                If (Index = UniqueVisible) Then
                    V(UniqueVisible) = R.Value
                    UniqueVisible = UniqueVisible + 1
                End If
            Next
        End If
    Next R

End Function

这算正常,如果我将 R.Delete 替换为 MsgBox(R.Row),我会得到正确的副本行号。

更新

这似乎不起作用

Function UniqueVisible(MyRange As Range) As Integer

    Dim ws As Worksheet
    Set ws = Worksheets(1)

    Dim R As Range

    Dim Dup As Integer
    Dup = 0

    Dim Dups() As Integer
    ReDim Dups(0 To MyRange.Count) As Integer

    Dim V() As String
    ReDim V(0 To MyRange.Count) As String


    For Each R In MyRange
        If (R.EntireRow.Hidden = False) Then
            For Index = 0 To UniqueVisible
                If (V(Index) = R.Value) Then
                    Dups(Dup) = R.Row
                    Dup = Dup + 1
                    Exit For
                End If

                If (Index = UniqueVisible) Then
                    V(UniqueVisible) = R.Value
                    UniqueVisible = UniqueVisible + 1
                End If
            Next
        End If
    Next R

    For Each D In Dups
        ws.Rows(D).Delete
    Next D

End Function

循环浏览行时不能删除行。您需要将需要删除的行存储在一个数组中,然后循环遍历数组并在完成循环行后删除行。

您似乎违反了一些规则。

  1. 您不能使用 函数 删除 VBA 中的行。无论您是将该函数用作工作表上的 用户定义函数 (又名 UDF)还是从 VBA 项目中的子程序调用它都没有关系。函数意味着 return 一个值,而不是在工作表上执行修改结构(甚至是其自身单元格以外的值)的操作。在您的情况下,它可以 return 一个要被子删除的行号数组。

  2. 删除行时从底部(或列的右侧)开始并向上处理被认为是规范的做法。当删除一行并循环到下一行时,从上到下工作可能会跳过行。

这是一个示例,其中子调用函数来收集唯一可见条目的计数和要删除的行数组。

Sub remove_rows()
    Dim v As Long, vDelete_These As Variant, iUnique As Long
    Dim ws As Worksheet

    Set ws = Worksheets(1)

    vDelete_These = UniqueVisible(ws.Range("A1:A20"))

    iUnique = vDelete_These(LBound(vDelete_These))

    For v = UBound(vDelete_These) To (LBound(vDelete_These) + 1) Step -1 'not that we are working from the bottom up
        ws.Rows(vDelete_These(v)).EntireRow.Delete
    Next v

    Debug.Print "There were " & iUnique & " unique, visible values."

End Sub

Function UniqueVisible(MyRange As Range)
    Dim R As Range
    Dim uniq As Long
    Dim Dups As Variant
    Dim v As String

    ReDim Dups(1 To 1) 'make room for the unique count
    v = ChrW(8203) 'seed out string hash check with the delimiter

    For Each R In MyRange
        If Not R.EntireRow.Hidden Then
            If CBool(InStr(1, v, ChrW(8203) & R.Value & ChrW(8203), vbTextCompare)) Then
                ReDim Preserve Dups(1 To UBound(Dups) + 1)
                Dups(UBound(Dups)) = R.Row
            Else
                uniq = uniq + 1
                v = v & R.Value & ChrW(8203)
            End If
        End If
    Next R

    Dups(LBound(Dups)) = uniq  'stuff the unique count into the primary of the array

    UniqueVisible = Dups

End Function

现在,我可能不会这样做。将整个内容写入单个子程序似乎更容易。但是,了解流程和限制很重要,因此我希望您能解决这个问题。

请注意,这没有任何错误控制。这应该在处理数组和循环删除行时出现。