필터링된 목록을 VBA로 루프하는 가장 쉬운 방법은 무엇입니까?

필터링된 목록을 VBA로 루프하는 가장 쉬운 방법은 무엇입니까?

Excel에 자동 필터가 설정되어 있고 VBA 코드로 한 열에 표시되는 모든 데이터를 순환하려면 가장 쉬운 방법이 무엇입니까?

필터링된 숨겨진 행을 모두 포함해서는 안 되므로 위에서 아래로 일반 범위를 지정하면 도움이 되지 않습니다.

어떤 좋은 생각 있어요?

제가 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하지만 위의 것들은 엑셀 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

을 사용하는 것이 좋습니다.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

단방향 A1에서 아래쪽으로 필터링된 데이터를 가정합니다.

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

사용했습니다.RowHeight범위의 특성(셀도 의미)입니다.0이면 숨겨집니다.따라서 모든 행을 일반적인 방법으로 반복합니다.if다음과 같이 해당 속성에 대한 조건 검사If myRange.RowHeight > 0 then DoStuff어디에DoStuff눈에 보이는 세포를 사용하여 수행할 수 있습니다.

특수 셀은 연속적이어야 하기 때문에 실제로 작동하지 않습니다.저는 제가 필요한 열을 기준으로 데이터를 정렬하기 위해 정렬 기능을 추가하여 해결했습니다.

코드를 공유할 계획이 없었기 때문에 코드에 대한 코멘트가 없어서 죄송합니다.

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

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

Thisworkbook.sheets("Mysheet").Range("A1).Currentregion.copy 
Thisworkbook.sheets("Othersheet").Range("A1)

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

언급URL : https://stackoverflow.com/questions/10849177/easiest-way-to-loop-through-a-filtered-list-with-vba