Вопрос по vba, excel-vba, excel – Самый простой способ перебрать отфильтрованный список с VBA?

33

Если в Excel настроен автофильтр и я хочу просмотреть все видимые данные в одном столбце с кодом VBA, какой самый простой способ сделать это?

Все скрытые строки, которые были отфильтрованы, не должны быть включены, поэтому простой диапазон сверху вниз не поможет.

Есть хорошие идеи? Благодарю.

Ваш Ответ

5   ответов
12

Я бы порекомендовал использовать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
Это хороший способ решения проблемы. Мне нравится ваш подход.
Я сталкиваюсь с «ошибкой 1004 во время выполнения: ошибка приложения или объекта»; на линии Установите filRange = .Offset (1, 0) .SpecialCells (xlCellTypeVisible) .EntireRow. Единственное отличие кода выше в том, что мой диапазон - .Range (& quot; A: J & quot;)
@PankajJaju: Извините, я вас не получил. Не могли бы вы объяснить, что вы имеете в виду? возможно с примером?
@SiddharthRout - если вы пересекаете адрес специальных ячеек (скажем, в столбце A), он даст вам адрес, такой как $ A1, $ A3: $ A5, $ A7, $ A10: $ A15 и так далее. Обратите внимание, что если видимые строки являются непрерывными, они отображаются в виде непрерывного диапазона, например, $ A10: $ A15, иначе они будут отдельными ячейками, такими как $ A1, $ A7 и т. Д.
Хорошее решение, Сид. Тем не менее, я был бы очень осторожен при использованииSpecialCells, Недавно я столкнулся с проблемой из-за способа, которым Excel отправляет.Address из этих клеток (на основе их непрерывного появления).
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
49

Предположим, у меня есть номера от 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.

EDIT

Просто нашел лучший способ с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
использованиеDebug.Print cl.row чтобы получить номер строки илиcl.address
Спасибо за ответы на все вопросы! Все они были более или менее одинаковыми (использование SpecialCells (xlCellTypeVisible) было ключом, который мне был нужен), поэтому трудно выбрать, какой ответ правильный. mattboy
-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
Было бы полезно, если бы вы предоставили некоторое объяснение того, что делает код.
8

Один способ, предполагающий отфильтрованные данные в A1 вниз;

dim Rng as Range
set Rng = Range("A2", Range("A2").End(xlDown)).Cells.SpecialCells(xlCellTypeVisible)
...
for each cell in Rng 
   ...     

Похожие вопросы