[ADO] 원하는 항목만 검색하여 별도의 시트에 출력하기

http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=264443866

상호나 품명으로 검색하면 해당 결과를 별도의 시트에 출력해주는 매크로.

신나신나

Option Explicit
Private OLEDB_Connect As String
Sub GetExcelVersion()
 
    Dim ExcelVersion As Integer
 
    '파일 버전을 확인하여 OLEDB를 사용할 버전을 정합니다.
    Select Case Application.Version
        Case Is <= 11: ExcelVersion = 8
        Case Is >= 12: ExcelVersion = 12
        Case Else
            MsgBox "엑셀 버전을 확인해주세요"
            Exit Sub
    End Select
    
    OLEDB_Connect = "Provider=Microsoft.Ace.OLEDB.12.0;" & _
            "Data Source='" & ThisWorkbook.FullName & "';" & _
            "Extended Properties =""Excel " & ExcelVersion & ".0 xml; HDR = YES"";"
            
End Sub
 
Sub Macro()
 
    Dim ADO_Connect As New ADODB.Connection
    Dim rS As New ADODB.Recordset
    Dim sql As String
    
    '기존자료 삭제
    Range("A8").CurrentRegion.Offset(1).ClearContents
    
    '엑셀버전에 따라 OLEDB를 결정합니다.
    Call GetExcelVersion
    
    'SQL을 지정합니다.
    sql = "select * "   '내역시트의 모든 데이터를 가져옵니다.
    sql = sql & "from [내역$" & Sheets("내역").Range("A1").CurrentRegion.Address(0, 0) & "]" '내역시트의 데이터 범위를 지정합니다.
    sql = sql & " where 상호='" & Range("C4") & "' or 품명='" & Range("E4") & "'" '상호 또는 품명이 일치하는 데이터를 가져옵니다.
    
    'ADO 및 레코드셋에 ADO_Connect
    ADO_Connect.Open OLEDB_Connect
    rS.Open sql, ADO_Connect, 3, 3, 1
    
    'A9셀에 검색 결과를 출력합니다. 검색결과가 없으면 공란을 출력합니다.
    Range("A9").CopyFromRecordset rS
 
    '변수 초기화
    rS.Close
    ADO_Connect.Close
    
    Set rS = Nothing
    Set ADO_Connect = Nothing
    
End Sub
 
 

샘플.xlsm