50

如果我在 Excel 中设置了一个自动过滤器，并且我想用 VBA 代码遍历一列中的所有可见数据，那么最简单的方法是什么？

不应包含所有已过滤掉的隐藏行，因此从上到下的普通 Range 无济于事。

有什么好主意吗？

4

8 回答 8

70

假设我的单元格中有数字 1 到 10，A2:A11而我的自动过滤器位于A1. 我现在过滤只显示大于 5 的数字（即 6、7、8、9、10）。

此代码将仅打印可见单元格：

Sub SpecialLoop()
    Dim cl As Range, rng As Range
    
    Set rng = Range("A2:A11")
    
    For Each cl In rng
        If cl.EntireRow.Hidden = False Then //Use Hidden property to check if filtered or not
            Debug.Print cl
        End If
    Next

End Sub

也许有更好的方法，SpecialCells但上述方法在 Excel 2003 中对我有用。

编辑

刚刚找到了一个更好的方法SpecialCells：

Sub SpecialLoop()
    Dim cl As Range, rng As Range
    
    Set rng = Range("A2:A11")
    
    For Each cl In rng.SpecialCells(xlCellTypeVisible)
        Debug.Print cl
    Next cl

End Sub
于 2012-06-01T12:09:51.573 回答
17

我建议使用Offset假设标题位于第 1 行。请参阅此示例

Option Explicit

Sub Sample()
    Dim rRange As Range, filRange As Range, Rng as Range
    'Remove any filters
    ActiveSheet.AutoFilterMode = False

    '~~> Set your range
    Set rRange = Sheets("Sheet1").Range("A1:E10")

    With rRange
        '~~> Set your criteria and filter
        .AutoFilter Field:=1, Criteria1:="=1"

        '~~> Filter, offset(to exclude headers)
        Set filRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow

        Debug.Print filRange.Address

        For Each Rng In filRange
            '~~> Your Code
        Next
    End With

    'Remove any filters
    ActiveSheet.AutoFilterMode = False
End Sub
于 2012-06-01T13:15:19.387 回答
11

一种方法是假设 A1 中的过滤数据向下；

dim Rng as Range
set Rng = Range("A2", Range("A2").End(xlDown)).Cells.SpecialCells(xlCellTypeVisible)
...
for each cell in Rng 
   ...
于 2012-06-01T12:11:00.793 回答
1

我使用RowHeight了范围的属性（这也意味着单元格）。如果它为零，则它是隐藏的。因此，只需像往常一样遍历所有行，但在if条件检查中检查该属性，因为您想对可见单元格执行If myRange.RowHeight > 0 then DoStuff哪些操作。DoStuff

于 2021-01-26T22:37:27.303 回答
0

SpecialCells 实际上并不工作，因为它需要是连续的。我通过添加排序功能解决了这个问题，以便根据我需要的列对数据进行排序。

抱歉没有对代码发表评论，因为我不打算分享它：

Sub testtt()
    arr = FilterAndGetData(Worksheets("Data").range("A:K"), Array(1, 9), Array("george", "WeeklyCash"), Array(1, 2, 3, 10, 11), 1)
    Debug.Print sms(arr)
End Sub
Function FilterAndGetData(ByVal rng As Variant, ByVal fields As Variant, ByVal criterias As Variant, ByVal colstoreturn As Variant, ByVal headers As Boolean) As Variant
Dim SUset, EAset, CMset
If Application.ScreenUpdating Then Application.ScreenUpdating = False: SUset = False Else SUset = True
If Application.EnableEvents Then Application.EnableEvents = False: EAset = False Else EAset = True
If Application.Calculation = xlCalculationAutomatic Then Application.Calculation = xlCalculationManual: CMset = False Else CMset = True
For Each col In rng.Columns: col.Hidden = False: Next col

Dim oldsheet, scol, ecol, srow, hyesno As String
Dim i, counter As Integer

oldsheet = ActiveSheet.Name


Worksheets(rng.Worksheet.Name).Activate

Worksheets(rng.Worksheet.Name).AutoFilterMode = False

scol = Chr(rng.Column + 64)
ecol = Chr(rng.Columns.Count + rng.Column + 64 - 1)
srow = rng.row

If UBound(fields) - LBound(fields) <> UBound(criterias) - LBound(criterias) Then FilterAndGetData = "Fields&Crit. counts dont match": GoTo done

dd = sortrange(rng, colstoreturn, headers)

For i = LBound(fields) To UBound(fields)
    rng.AutoFilter Field:=CStr(fields(i)), Criteria1:=CStr(criterias(i))
Next i

Dim rngg As Variant

rngg = rng.SpecialCells(xlCellTypeVisible)
Debug.Print ActiveSheet.AutoFilter.range.address
FilterAndGetData = ActiveSheet.AutoFilter.range.SpecialCells(xlCellTypeVisible).Value

For Each row In rng.Rows
    If row.EntireRow.Hidden Then Debug.Print yes
Next row


done:
    'Worksheets("Data").AutoFilterMode = False
    Worksheets(oldsheet).Activate
    If SUset Then Application.ScreenUpdating = True
    If EAset Then Application.EnableEvents = True
    If CMset Then Application.Calculation = xlCalculationAutomatic
End Function
Function sortrange(ByVal rng As Variant, ByVal colnumbers As Variant, ByVal headers As Boolean)

    Dim SUset, EAset, CMset
    If Application.ScreenUpdating Then Application.ScreenUpdating = False: SUset = False Else SUset = True
    If Application.EnableEvents Then Application.EnableEvents = False: EAset = False Else EAset = True
    If Application.Calculation = xlCalculationAutomatic Then Application.Calculation = xlCalculationManual: CMset = False Else CMset = True
    For Each col In rng.Columns: col.Hidden = False: Next col

    Dim oldsheet, scol, srow, sortcol, hyesno As String
    Dim i, counter As Integer
    oldsheet = ActiveSheet.Name
    Worksheets(rng.Worksheet.Name).Activate
    Worksheets(rng.Worksheet.Name).AutoFilterMode = False
    scol = rng.Column
    srow = rng.row

    If headers Then hyesno = xlYes Else hyesno = xlNo

    For i = LBound(colnumbers) To UBound(colnumbers)
        rng.Sort key1:=range(Chr(scol + colnumbers(i) + 63) + CStr(srow)), order1:=xlAscending, Header:=hyesno
    Next i
    sortrange = "123"
done:
    Worksheets(oldsheet).Activate
    If SUset Then Application.ScreenUpdating = True
    If EAset Then Application.EnableEvents = True
    If CMset Then Application.Calculation = xlCalculationAutomatic
End Function
于 2018-07-06T23:15:41.073 回答
0 
a = 2
x = 0

Do Until Cells(a, 1).Value = ""
If Rows(a).Hidden = False Then
x = Cells(a, 1).Value + x
End If
a = a + 1
Loop

End Sub
于 2019-04-09T11:55:30.867 回答
0 
Thisworkbook.sheets("Mysheet").Range("A1).Currentregion.copy 
Thisworkbook.sheets("Othersheet").Range("A1)
于 2021-03-30T06:02:46.397 回答
-1 
Call MyMacro()

ActiveCell.Offset(1, 0).Activate

Do Until Selection.EntireRow.Hidden = False
If Selection.EntireRow.Hidden = True Then
ActiveCell.Offset(1, 0).Activate
End If
Loop
于 2014-10-03T18:44:41.763 回答