'다른 시트 데이터 가져오기'에 해당되는 글 1건

728x90

SQL 기능을 이용하여 원하는 데이터 가져오기


다른 파일이나 같은 파일내 다른 시트에서 자료를 데이터베이스처럼 가져오는 기능을 구현한 것이다.

외국자료를 참조하였고, 필요한 기능을 보강하고, 편의성을 중점적으로 보강한 거의 완벽에 가까운 자료이다.


Where 조건문을 포함할 수도 있고 포함하지 않을 수 있는 경우를 모두 고려하여 만들려고 하는데, 사과이름 변수는 꼭 포함해야만 동작이 된다. 좀 더 공부하면 이 부분도 해결할 수 있지 않을까?

등급, 입고일, 출하일 은 모두 빈공백으로 설정하면 Where 검색조건에서 제외되도록 했다.


FileData_Get.xlsm


Asample.xlsx


Sub ExcelFileData_Get()
'// This sub will pull data from an external .xlsx file.
'// The ADO 6.0 object library reference must be loaded.
    Dim conn As ADODB.Connection      '// 연결변수 선언
    Dim RS As ADODB.Recordset
    Dim strSQL As String              '// SQL 문을 위한 변수
    Dim sht1 As Worksheet           '// 워크시트 변수
    Dim RSCount As Integer          '// 총 레코드(행)의 수 변수 선언
    Dim FieldCount As Integer       '// 총 필드(열)의 수 변수 선언
    Dim i, j, sRow As Integer
    Dim NoRecords As Boolean
    Dim FilePath As String          '// 파일 경로 변수
    Dim FileName As String         '// 가져올 엑셀 파일명 변수
    Dim a, b, c, d, T, U As String
       
    Set sht1 = Sheets("Main")      '// 현재 작업중인 워크시트 명
    Set conn = New ADODB.Connection
   
    FilePath = ThisWorkbook.Path + "\"  '// 현재 파일 경로
'    FileName = "Asample.xlsx"      '// 다른 엑셀파일
    FileName = ActiveWorkbook.Name      '// 같은 엑셀파일(현재 엑셀화면에 활성화된 파일)
   
    T = sht1.Range("B3")      '// 사과이름
    U = sht1.Range("C3")      '// 등급
    a = sht1.Range("D3")     '// 입고일
    b = sht1.Range("E3")     '// 입고일
    c = sht1.Range("F3")     '// 출하일
    d = sht1.Range("G3")     '// 출하일
    
    strSQL = "SELECT * FROM [Data$] "           '// 엑셀시트이면 뒤에 $ 를 붙인다. Data Sheet 가 존재해야 한다.
    If T <> vbNullString Then strSQL = strSQL & "Where 사과이름=""" & T & """"     '// 사과이름 필드 (텍스트 변수 처리)
    If U <> vbNullString Then strSQL = strSQL & " and 등급=""" & U & """"        '// 등급 필드 (텍스트 변수 처리)
   
    If a <> vbNullString And b <> vbNullString Then
        strSQL = strSQL & "And (입고일 Between #" & a & "# And #" & b & "#) "  '// 입고일 a~b 일까지 (날짜변수 처리)
    ElseIf a <> vbNullString And b = vbNullString Then
        strSQL = strSQL & "And (입고일 = #" & a & "#) "     '// 입고일 a (날짜변수 처리)
    ElseIf a = vbNullString And b <> vbNullString Then
        strSQL = strSQL & "And (입고일 = #" & b & "#) "     '// 입고일 b (날짜변수 처리)
    End If
   
    If c <> vbNullString And d <> vbNullString Then
        strSQL = strSQL & "And (출하일 Between #" & c & "# And #" & d & "#) "    '// 입고일 a~b 일까지 (날짜변수 처리)
    ElseIf c <> vbNullString And d = vbNullString Then
        strSQL = strSQL & "And (출하일 = #" & c & "#) "     '// 입고일 a (날짜변수 처리)
    ElseIf c = vbNullString And d <> vbNullString Then
        strSQL = strSQL & "And (출하일 = #" & d & "#) "     '// 입고일 a (날짜변수 처리)
    End If
'    strSQL = strSQL & "Order By 사과이름"       '// 사과이름 기준으로 오름차순 정렬
   
    With conn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & FilePath & FileName & ";" & _
            "Extended Properties=Excel 12.0;"
        .Open
    End With
   
    Set RS = conn.Execute(strSQL)
   
    With ActiveWorkbook.ActiveSheet.Range("A5")    '// A5열부터 데이터 출력
        .CurrentRegion.Offset(1).ClearContents    '// 현재 존재하는 값을 전부 삭제
        sRow = Cells(Rows.Count, "A").End(3)(2).Row     '// 첫번째 값을 뿌릴 행의 값
       
        NoRecords = False
        With RS
            FieldCount = .Fields.Count      '// 전체 필드(제목열)의 개수
            For i = 0 To .Fields.Count - 1     '// 레코드셋 제목 전부 가져오기
                sht1.Cells(5, 1).Offset(, i) = .Fields(i).Name
            Next i
           
            If Not (.BOF And .EOF) Then
                NoRecords = False
                .MoveFirst
                While Not .EOF
                    .MoveNext
                    RSCount = RSCount + 1   '// 전체 레코드수 구하기
                Wend        '// 주어진 조건이 True인 동안은 일련의 문을 계속 실행
            Else
                NoRecords = True
                MsgBox ("No records in target")
                Exit Sub
            End If
           
            .MoveFirst      '// 레코드의 처음으로 이동
            While Not .EOF      '// EOF 를 만나기 전까지 계속 반복하라
                For i = sRow To sRow + RSCount - 1 Step 1   '// 총 행의 수만큼 반복
                    For j = 1 To FieldCount Step 1      '// 총 열의 수만큼 반복
                        sht1.Cells(i, j) = .Fields(j - 1)        '// 셀에 값을 기록하라
                    Next j
                    .MoveNext   '// 다음 레코드(행)으로 이동
                Next i
            Wend
        End With
    End With
    RS.Close
    conn.Close
    Set RS = Nothing
    Set conn = Nothing
   
    MsgBox RSCount & "개 데이터 가져오기 완료"
End Sub



블로그 이미지

Link2Me

,