복수의 조건으로 고급필터 적용하기 2 (엑셀 VBA 매크로)

[다니엘박]

(1430) 복수의 조건으로 고급필터 적용하기 2 (엑셀 VBA 매크로) Sort 필터 / 엑셀,VBA,매크로 2013/12/25 21:39 http://blog.naver.com/rosa0189/60206041339 전용뷰어 보기 첨부파일 (4) B1:B5 셀에 입력한 조건으로 S1 ~ S12 까지 12개의 시트에서 부분일치하는 데이터를 가져오는 기능. 특정인이 아닌 다수의 사람들이 이 매크로를 사용할 수 있도록 최대한 배려를 하였다. 열 개수에 제한이 없으므로 첨부된 파일을 내려받은 뒤 자신의 데이터를 복사하여 붙여넣고 사용하면 된다(단 2열 이상이어야 함). 시트개수에 제한이 없으므로 시트개수를 늘리거나 삭제하여 줄여도 된다. 시트이름에 제한이 없으므로 원하는 이름으로 S1 ~ S12 시트의 이름을 바꾸어도 된다. 시트위치에 제한이 없으므로 원하는 아무 위치에나 뒤죽박죽 시트를 위치하여도 된다. B1:B5의 조건은 입력하고 싶은 것만 입력하면 됨. 즉, B4셀에 "거래처명" 하나만 입력하거나  B1:B5 모두 조건을 입력하여도 된다. 행제목이 한 자라도 틀리면 에러나므로, S1 ~ S12 시트의 행제목을 복사하여 Main 시트에 붙여 넣고, filter 시트의 제목은 Main 시트의 제목을 복사하여 붙여 넣는게 오류 방지에 좋다. 데이터 시트인 S1 ~ S12 시트에는 첫 행이 제목, 2번째 행부터 데이터가 입력되어야 한다. Main 시트 및 filter 시트는 아래의 코드를 모두 이해할지 못하는 경우 수정하지 않는 것이 좋다. 매크로 실행 전 Main 시트. 윗그림에 나타나지 않지만 S1 ~ S12 시트까지 있음. 매크로 실행 전 filter 시트. Main 시트의 필터 조건을 고급필터 조건에 맞도록 행으로 변환. A2:E2 셀에는 수식이 적혀 있음. 첨부된 파일 참조. Run Macro 버튼을 클릭하여 매크로 실행 후 Main 시트의 결과. 시작일과 종료일 사이의 데이터를 가져왔으며, "구분"과 "거래처명"은 부분일치 되는 데이터를 가져온 모습. B3셀에 "매" 라고 입력 시 "매입" 및 "매출" 모두 가져온다. "CLEAR" 버튼을 클릭하면 Main 시트의 데이터를 삭제. 동영상의 순서별 설명 : Main 시트는 매크로를 실행하는 시트이고, S1~S12 시트에는 데이터가 입력됨. filter시트에는 고급필터 적용하기 위한 필터링 조건을 넣음. 매크로 실행 후 종료메시지와 함께 부분일치 조건에 맞는 데이터를 가져옴. 조건을 변경하고 매크로 실행. "구분"에서 "매"자만 입력하여 "매입"과 "매출"모두 가져옴. 조건을 변경하고 매크로 실행. 부분일치 아닌 전체일치 데이터 가져오기 위해 "구분"과 "거래처명"의 전체이름을 입력 시 전체가 일치하는 데이터만 가져옴.   Option Explicit Sub advanced_Filter_Multiple_Conditions_2()     Dim i As Integer                                             '반복 코드에 사용할 변수     Dim rngData As Range                                   '전체 데이터 영역을 넣을 변수     Dim rngCri As Range                                     '필터링 조건 영역을 넣을 변수     Dim wks As Worksheet                                   '각 시트를 넣을 변수     Dim rngT As Range                                        '필터된 결과 복사될 위치 넣을 변수     Dim colsCnt As Integer                                   '필터된 결과들의 열 개수 넣을 변수         Application.ScreenUpdating = False                 '화면 업데이트 (일시)정지       If WorksheetFunction.CountA(Range("B1:B5")) < 1 Then    'B1:B5가 비어 있으면         MsgBox "필터링 조건이 없습니다. 종료합니다.", 64, "데이터입력 오류"         Exit Sub                                                   '매크로 종료     End If         colsCnt = ActiveSheet.UsedRange.Columns.Count   '전체 열개수를 변수에 넣음         Cells(7, 1).CurrentRegion.Offset(1).Clear         '기존 데이터 삭제         With Sheets("filter")                                       '필터기준 시트에서         .Cells(1, 1).CurrentRegion.Copy .Cells(1, Columns.Count).End(1)(1, 3)         '필터기준 영역을 복사하여 종단셀 이용 오른쪽에 복사                 '----------------------------------------------------------         ' filter 시트의 rngCri 셀에 입력 값이 없는 셀을 삭제하는 코드         '----------------------------------------------------------         For i = 5 To 1 Step -1                                 '1씩 줄여가면서 5회 반복             If Len(.Cells(2, i)) < 1 Then                   '만일 셀값의 길이가 1보다 작으면                 .Cells(2, i).EntireColumn.Delete          '전체 열을 삭제             End If         Next i                 Set rngCri = .Cells(1, 1).CurrentRegion        '추출된 필터조건 영역을 변수에 넣음     End With         For Each wks In ActiveWorkbook.Worksheets   '각 시트를 순환             '-------------------------------------------------------------------         ' Main과 filter시트가 아닌 시트를 순환하며 조건에 따라 복사하는 코드         '-------------------------------------------------------------------         If wks.Name <> "Main" And wks.Name <> "filter" Then                                                                       '시트이름이 Main이 아니고 filter도 아닌 경우                         If wks.Range("A2") <> "" Then               '데이터가 하나라도 있으면                 wks.Activate                                    '활성화                 Set rngData = wks.UsedRange           '사용영역을 변수에 넣음                     Set rngT = Sheets("Main").Cells(Rows.Count, "A").End(3)(2).Resize(, colsCnt)                                                                       '복사가 될 타겟 지점을 변수에 넣음                                 rngData.AdvancedFilter _                     Action:=xlFilterCopy, _                     CriteriaRange:=rngCri, _                     CopyToRange:=rngT, _                     Unique:=False                              '각 조건에 따라 고급필터 적용                                     rngT.EntireRow.Delete                   '제목행 전체 삭제             End If         End If     Next wks                 '----------------------------------------------     ' filter 시트에서 임시로 복사한 조건열을 삭제     '----------------------------------------------     With rngCri                                                   'rngCri 영역에서         .Resize(, .Columns.Count + 1).EntireColumn.Delete   '열을 1개 늘려서 삭제     End With             Sheets("filter").Columns.AutoFit                      '전체열 열너비 자동맞춤             With Sheets("Main")         .Activate                                                   'Main 시트 활성화         Range("A7").CurrentRegion.Sort [A7], xlAscending, Header:=xlYes '오름차순 정렬     End With         Set rngCri = Nothing     Set rngData = Nothing                                    '개체변수(들) 초기화     Set rngT = Nothing End Sub   '---------------------------------------------- ' Clear버튼에 연결된 Main 시트 데이터 삭제 코드 '---------------------------------------------- Sub clear_Data()     Cells(7, 1).CurrentRegion.Offset(1).Clear         '기존 데이터 삭제 End Sub  [출처] (1430) 복수의 조건으로 고급필터 적용하기 2 (엑셀 VBA 매크로)|작성자 니꾸