删除重复的可见行
我正在尝试使用下面的VBA代码来做两件事情。
- 计算过滤的工作表中唯一可见行的数量。
- 删除重复的行
至今：
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 这个计数好，如果我用MsgBox(R.Row)replaceR.Delete ，我得到了重复的正确的行号。
-
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
看来你在这里打破了一些规则。
-
您不能使用函数来删除VBA中的行。 无论您是将该函数用作工作表上的用户定义函数 （又名UDF），还是从VBA项目中的子项中调用该函数，都无关紧要。 函数是为了返回一个值，而不是在工作表上执行修改结构的操作（或者甚至是它自己的单元格以外的值）。 在你的情况下，它可能会返回一个行号的数组被子删除。
-
从底部开始（或列的右侧）被认为是规范的做法，并在删除行时进行处理。 当一行被删除，并且循环到下一行时，从顶部到底部的工作可能跳过行。
这里是一个例子，其中一个子调用函数来收集唯一的，可见的条目的计数和要删除的行数组。
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
现在，这可能不是我将如何去做。 似乎更容易把整个事情写入一个单独的子。 但是，了解stream程和限制是非常重要的，所以我希望您可以使用它。
请注意，这没有任何错误控制。 在处理数组和删除循环中的行时，这应该是存在的。
在循环行时，不能删除一行。 您需要将需要删除的行存储在数组中，然后在数组中循环并删除行。