我正在尝试使用以下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
这样就可以了,如果我将
R.Delete
替换为MsgBox(R.Row)
,我将获得重复项的正确行号。R.Delete
什么也不做。R.EntireRow.Delete
什么都不做ws.Rows(R.Row).Delete
什么也不做。更新
这似乎不起作用
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
现在,这可能不是我会去做的。将整个内容写到单个子文件中似乎更容易。但是,了解流程和局限性很重要,因此我希望您可以使用它。
请注意,这没有任何错误控制。在处理数组和删除循环中的行时应显示此内容。