VB(A)

순서대로 필터링하기

당근쨈 2017. 2. 4. 16:24

매크로 흐름


1. B열의 고유값만 배열에 담는다

2. 필터링이 되어있는지 체크하여

2-1. 필터링이 되어있으면 다음 조건으로 넘어가고

2-2 필터링이 되어있지 않으면 맨 처음값으로 필터를 한다.

3. 마지막 조건이 되면 처음 조건으로 되돌아간다.

4. 초기화 버튼을 누르면 필터가 해제된다.


자세한 건 주석으로.





Sub GetName()
 
    Dim D As Object
    Dim v, i%, j%
    Dim MyCriteria$
    Dim MyArea As Range
    
    Set D = CreateObject("Scripting.Dictionary")    'Dictionary 선언
    v = Range("B2", Cells(Rows.Count, 2).End(3))    'B열을 배열에 삽입
    Set MyArea = Range("A1").CurrentRegion  '필터링 할 데이터영역
    
    'B열을 순환하며 고유값만 Dictionary에 담습니다.
    '이 값은 자동필터의 조건에 쓰입니다.
    For i = 1 To UBound(v, 1)
        If Not D.exists(v(i, 1)) Then
            D.Add v(i, 1), j
            j = j + 1
        End If
    Next i
    v = D.keys  'Dictionary값을 배열에 다시 담습니다. 자동필터의 조건이 됩니다.
                
    MyCriteria = Mid(AutoFilter_Criteria(Range("B1")), 2)   'B열에 필터가 걸려있는지 확인합니다.
    
    '필터가 걸려있는지 판단하여
    '필터가 걸려있으면 다음 조건으로 넘어가서 다시 필터링을 합니다.
    '마지막 조건으로 필터가 되어있으면 처음 조건으로 되돌아갑니다.
    Select Case MyCriteria
        Case ""
            MyArea.AutoFilter field:=2, Criteria1:=v(0)
        
        Case Else
            j = D.Item(MyCriteria)
            If j = D.Count - 1 Then
                MyArea.AutoFilter field:=2, Criteria1:=v(0)
            Else
                MyArea.AutoFilter field:=2, Criteria1:=v(j + 1)
            End If
            
    End Select
    
End Sub
Function AutoFilter_Criteria(Header As Range) As String
'자동필터의 조건을 가져오는 사용자정의함수
 
    With Header.Parent.AutoFilter
 
        With .Filters(Header.Column - .Range.Column + 1)
 
            Select Case .On
                Case True: AutoFilter_Criteria = .Criteria1
                Case False: AutoFilter_Criteria = ""
            End Select
            
        End With
        
    End With
 
End Function
 
Sub CleanFilter()
'필터 초기화
 
    On Error Resume Next
    
    ActiveSheet.ShowAllData
    
    On Error GoTo 0
    
End Sub
cs