매크로 흐름
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 |
'VB(A)' 카테고리의 다른 글
[VB.Net] 포토갤러리 일괄 다운로더 (0) | 2017.03.05 |
---|---|
[정규식] 일치하는 문자열만 추출(lazy 모드) (0) | 2017.02.05 |
[Adodb.Stream] json 파일로 추출하기 (0) | 2017.01.10 |
[Dictionary] 일정 정보만을 그대로 두고 여럿 존재하는 값(행렬 전환하여 붙이기) (0) | 2016.12.27 |
숫자 합치기 + 음수만 빨갛게 (0) | 2016.12.23 |