删除重复的可见行 [英] Deleting Duplicate Visible Rows

问题描述

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

I am trying to use the following VBA code to do two things.

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)，我将获得重复项的正确行号.

This counts okay, and if I replace R.Delete with MsgBox(R.Row) I get the correct row number of the duplicate.

• R.Delete不执行任何操作.
• R.EntireRow.Delete什么都不做
• ws.Rows(R.Row).Delete不执行任何操作.

• R.Delete does nothing.
• R.EntireRow.Delete does nothing
• ws.Rows(R.Row).Delete does nothing.

更新

这似乎不起作用

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

推荐答案

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

It seems you're breaking a few rules here.

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

1. You cannot use a function to delete rows in VBA. It does not matter whether you are using the function as a User Defined Function (aka UDF) on the worksheet or calling it from a sub in a VBA project. A function is meant to return a value, not perform operations that modify the structure (or even the values other than its own cell) on a worksheet. In your case, it could return an array of row numbers to be deleted by a sub.

从底部开始(或在列的右侧)开始，然后在删除行时开始工作，被认为是一种规范的做法.当删除一行并循环到下一个时，从上到下的工作可能会跳过行.

It is considered canonical practise to start from the bottom (or the right for columns) and work up when deleting rows. Working from the top to the bottom may skip rows when a row is deleted and you loop to the next one.

这里是一个示例，其中子程序调用该函数以收集唯一可见条目的计数以及要删除的行数组.

Here is an example where a sub calls the function to gather the count of the unique, visible entries and an array of rows to be removed.

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

现在，那可能不是我要去做的.将整个内容写到单个子文件中似乎更容易.但是，了解流程和局限性很重要，因此我希望您可以使用它.

Now, that is probably not how I would go about it. Seems easier to just write the whole thing into a single sub. However, understanding processes and limitations is important so I hope you can work with this.

请注意，这不没有任何错误控制.在处理数组和删除行内循环时应显示此值.

Note that this does not have any error control. This should be present when dealing with arrays and deleting row in loops.

这篇关于删除重复的可见行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！