나눔터  
  HOME > 나눔터 > 묻고답하기 > 엑셀
엑셀
엑셀에 대한 질문과 답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
 "000 님, 도와주세요", "부탁 드립니다.", "급합니다!" 등과 같이 막연한 제목을 달지 말아주세요.
[필독] 빠르고 정확한 답변을 얻는 16가지 Tip !
[필독] 저작권법 개정에 따른 이용안내
작성자:  

 참서리 (k5953)

추천:  2
파일:     filter-1.xls (85.5KB) 조회:  1066
제목:   [RE]엑셀필터 관련 문의 드립니다.
     
 


'---------------------------------
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

 
[불량 게시물 신고]  
아침이슬답변감사드립니다. 어렵네요. 
추운날씨 건강조심하시고 항상 행복하세요
11-19 (19:06)
삭제 ■신고
        
  

작성일 : 2018-11-19(17:16)
최종수정일 : 2018-11-19(17:16)
 


 ◎ 관련글

  제 목   작성자   날짜
엑셀필터 관련 문의 드립니다. 아침이슬 2018-11-19
[RE]엑셀필터 관련 문의 드립니다. 참서리 2018-11-19