条件不适用于过滤后的数据

Question

1. 过滤数字> 0的数据
2. 选择数据可见的单元格并使其为“0”
3. 删除过滤器

过滤后没有行和超过一行时，我的代码工作正常。但是当过滤器后只剩下一行时失败。有人可以帮忙吗？

Rows("1:1").Select
Range("C1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$J$98").AutoFilter Field:=3, Criteria1:=">0", Operator:=xlAnd
Range("C1").Select
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
    ActiveCell.Offset(1, 0).Select
Loop
If ActiveCell = vbNullString Then
    ActiveSheet.Range("$A$1:$J$98").AutoFilter Field:=3
Else
    ActiveCell.FormulaR1C1 = "0"
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    ActiveSheet.Paste
    ActiveSheet.Range("$A$1:$J$98").AutoFilter Field:=3
End If

Answer 1

Sub FilterAndCopy()
    With Range("A1:J98")
        .AutoFilter Field:=3, Criteria1:=">0"
        .Copy Range("THE_RANGE_YOU_NEED_TO_COPY_TO")
        .AutoFilter
    End With
End Sub

说明

过滤范围后，Copy方法仅复制可见细胞。 Destination的Copy参数是您要粘贴数据的位置（可以是任何工作表）。

Answer 2

如果使用SpecialCells（xlVisible）和Intersect命令，则更简单。

Sub tt()
Set sh = ActiveSheet
If sh.FilterMode Then sh.AutoFilterMode = False
Set r = sh.Range("$A1:$J$98")
Field = 3
r.AutoFilter Field:=Field, Criteria1:=">0", Operator:=xlAnd
Set FilterData = Intersect(r, r.Offset(1))
Set VisibleData = Nothing
On Error Resume Next
Set VisibleData = FilterData.SpecialCells(xlVisible)
On Error GoTo 0
If VisibleData Is Nothing Then
Else
 VisibleData.Columns(Field).Cells.Formula = "0"
End If
sh.AutoFilterMode = False
End Sub