删除重复的可见行

Question

我试图使用以下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)我得到重复的正确行号.

• R.Delete 什么也没做.
• R.EntireRow.Delete 什么也没做
• ws.Rows(R.Row).Delete 什么也没做.

UPDATE

这似乎不起作用

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

Answer 1

看来你在这里违反了一些规则.

1. 您无法使用函数删除VBA中的行.无论您是在工作表上使用该函数作为用户定义函数(也称为UDF),还是从VBA项目中的子函数调用它,都无关紧要.函数意味着返回一个值,而不是执行修改工作表上的结构(甚至是其自身单元格以外的值)的操作.在您的情况下,它可以返回要由子删除的行号数组.

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

下面是一个示例,其中sub调用函数来收集唯一的可见条目的计数以及要删除的行数组.

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

现在,这可能不是我怎么做的.似乎更容易将整个事物写入单个子.但是,了解流程和限制很重要,所以我希望您能够解决这个问题.

请注意,这并不能有任何差错控制.在处理数组和删除循环中的行时应该存在这种情况.