AutoFilter를 이용한 셀 일치하는 Row 자동 가져오기 VBA
특정한 구분자를 넣으면 해당되는 것만 필터링 해서 가져오는 VBA 코드 입니다.
하는 방법은 필터링해서 가져오고자 하는 Sheet 를 선택합니다.
선택하고 나서 마우스 우클릭을 한 다음에 나오는 코드 보기를 누릅니다.
이런 창이 뜹니다. 여기에 아래 VBA Code를 붙여넣기 하고 나서 창을 닫으면 끝 입니다.
코드를 수정하고 싶으면 위 방법대로 코드를 보면서 수정하면 됩니다.
현재 부족한 부분은 work 시트에서 첫번째 머리글에 해당하는 것의 값과 서식만 복사해서 붙여넣는 걸 아직 처리를 못한 상태입니다. 나머지는 원하는 자료를 순식간에 가져오기가 됩니다.
첫줄 Private Sub Worksheet_Change(ByVal Target As Range) 를 다른 이름으로 변경하면 안되더라구요.
코드 설명은 A2 열의 값이 입력되면 가져오고 그렇지 않으면 동작되지 않도록 되어 있습니다.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngAll As Range
Dim rngC As Range
Dim Taget As String
If Target.Address <> "$A$2" Then Exit Sub
If Target <> "" Then
Application.ScreenUpdating = False '// 화면 업데이트 (일시) 중지
Range("A5").CurrentRegion.Offset(1).Clear '// 기존 데이터를 전부 삭제
Set rngAll = Sheets("work").Range("A1").CurrentRegion '// A1 열과 연결된 인접셀 영역
Set rngC = rngAll.Columns(1) '// 전체범위에서 선택할 열 1은 A열
Set rngAll = rngAll.Rows(2).Resize(rngAll.Rows.Count - 1)
'// A2 행부터 범위 재지정
With ActiveSheet '// 해당 시트명 직접 입력
rngC.AutoFilter 1, Target, , , False
'// Target 만 필터링, 즉 Columns(1) 열에서 Target 과 일치하는 열만 필터링
'// xlOr, xlAnd
rngAll.Copy .Cells(Rows.Count, 1).End(3)(2)
'// 자동 필터된 값을 연습 시트의 마지막 값이 들어있는 아래행에 복사하라
End With
rngC.AutoFilter '// 자동필터 해제
Columns.AutoFit '// 열너비 자동 맞춤
End if
End Sub
그리고 아래 Code는 버튼을 누르면 A2 셀 값에 해당되는 조건에 맞는 것만 필터링해서 가져옵니다.
똑같은데 위에 있는 코드와 어떤 부분이 차이가 있는지 살펴보면 금방 아실 겁니다.
Sub AutoFilter_Copy()
Dim rngAll As Range
Dim rngC As Range
Dim Taget As String
Target = Cells(2, 1).Value '// 조건 검색어
If Target <> "" Then
Application.ScreenUpdating = False '// 화면 업데이트 (일시) 중지
Range("A5").CurrentRegion.Offset(1).Clear '// 기존 데이터를 전부 삭제
Set rngAll = Sheets("work").Range("A1").CurrentRegion '// A1 열과 연결된 인접셀 영역
Set rngC = rngAll.Columns(1) '// 전체범위에서 선택할 열 1은 A열
Set rngAll = rngAll.Rows(2).Resize(rngAll.Rows.Count - 1)
'// A2 행부터 범위 재지정
With ActiveSheet '// 해당 시트명 직접 입력
rngC.AutoFilter 1, Target, , , False
'// 현재 시트(ActiveSheet)에서 Target 만 자동 선별
'// xlOr, xlAnd
rngAll.Copy .Cells(Rows.Count, 1).End(3)(2)
'// 자동 필터된 값을 시트의 마지막 값이 들어있는 아래행에 복사하라
End With
rngC.AutoFilter '// 자동필터 해제
Columns.AutoFit '// 열너비 자동 맞춤
End If
End Sub
'업무 능력 향상 > 엑셀 VBA 활용' 카테고리의 다른 글
[VBA] 최대값 셀에 배경색 지정 (0) | 2014.02.12 |
---|---|
AutoFilter를 이용하여 찾는 내용이 포함된 셀의 행 가져오기 VBA (1) | 2014.02.08 |
색상별로 시간합계 구하기 (SumIF 함수 사용) (0) | 2014.02.02 |
색상 개수와 색깔 표시하기 (동일 시트) - CountIF 함수 이용 (0) | 2014.02.01 |
업체별 공급가액 합계 및 정렬 2 (SUMIF 함수 사용) (0) | 2014.02.01 |