|
'---------------------------------
Sub filtering()
'---------------------------------
' 화면 업데이트 중지
Application.ScreenUpdating = False
' 소스 자료 배열(2차원 배열)
Dim data As Variant: data = Worksheets("내용").Range("A1").CurrentRegion.Columns(2).Value
' 찾을 내용
Dim sSearch As Variant: sSearch = Worksheets("실무").Range("C3").Value
' 찾을 내용이 업으면 종료
If VBA.Len(sSearch) = 0 Then Exit Sub
' 찾은 자료를 담을 배열 선언
Dim arr As Variant: arr = Array()
' 소스 자료를 빙빙 돌며
'-----------------------------------------
For r = LBound(data, 1) To UBound(data, 1)
'-----------------------------------------
' 찾은 내용을 참으면 배열에 담기
If VBA.InStr(1, data(r, 1), sSearch) >= 1 Then
arr = push(arr, data(r, 1))
End If
Next r
' 찾은 내용이 없으면 종료
If UBound(arr) = -1 Then Exit Sub
' 찾은 내용이 있으면 시트에 붙여 넣기
With Worksheets("실무").Range("E7")
'기존 자료 지우기
.CurrentRegion.ClearContents
' 붙여넣기
' value 속성은 배열을 받고, 배열을 리턴한다.
.Resize(UBound(arr) + 1, 1).Value = WorksheetFunction.Transpose(arr)
End With
' 화면 업데이트 활성화
Application.ScreenUpdating = True
End Sub
' 배열에 자료 추가
'--------------------------------------------------------
Function push(col As Variant, ele As Variant) As Variant
'--------------------------------------------------------
Dim i As Long: i = UBound(col) + 1
ReDim Preserve col(i)
col(i) = ele
push = col
End Function
|
|