Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
847 views
in Technique[技术] by (71.8m points)

vba - Deleting Duplicate Visible Rows

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

  1. Count the number of unique visible rows in a filtered worksheet.
  2. Delete the duplicate rows

So far:

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

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

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

UPDATE

This doesn't seem to be working

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
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

It seems you're breaking a few rules here.

  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.

  2. 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.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...