728x90

다른 시트 자료를 SQL 방식으로 가져오는 걸 지난번에 한번 해봤는데 네이버지식인에 올라온 문의사항을 보니 AutoFilter 를 이용하는 것보다 SQL 형태로 가져오면 좋겠다는 생각이 들어서 다시 한번 해봤다.

그러면서 SQL 조건에서 자료형식 체크하는 걸 추가했다.

내가 잘 몰라서인지 서식까지 그대로 복사를 하지 못했다.



Help_FileData.xlsm


Sub ExcelFileData_Get()
'// 외부 엑셀파일을 가져올 수도 있고 다른 시트 내용을 가져올 수도 있음
'// The ADO 6.0 object library reference must be loaded.
    Dim DBconn 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, S, T, U As String
       
    Set sht1 = Sheets("Main")      '// 현재 작업중인 워크시트 명
    Set DBconn = New ADODB.Connection
   
    FilePath = ThisWorkbook.Path + "\"  '// 현재 파일 경로
'    FileName = "Asample.xlsx"      '// 다른 엑셀파일명을 적어주고 주석을 제거하려면 아래 행은 주석처리 해야 함
    FileName = ActiveWorkbook.Name      '// 같은 엑셀파일(현재 엑셀화면에 활성화된 파일)
   
    S = sht1.Range("A3")      '// 업체코드
    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 S <> vbNullString Then
        If IsNumeric(S) = False Then
            MsgBox "업체코드는 숫자를 입력하셔야 합니다"
            Exit Sub
        Else
            strSQL = strSQL & " and 업체코드=" & S & ""        '// 업체코드 필드 (숫자 변수 처리)
        End If
    End If
    If U <> vbNullString Then
        If IsNumeric(S) = False Then
            MsgBox "품목코드는 숫자를 입력하셔야 합니다"
            Exit Sub
        Else
            strSQL = strSQL & " and 품목코드=" & U & ""        '// 품목코드 필드 (숫자 변수 처리)
        End If
    End If
   
    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 DBconn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & FilePath & FileName & ";" & _
            "Extended Properties=Excel 12.0;"
        .Open
    End With

    Set RS = DBconn.Execute(strSQL)
   
    With ActiveWorkbook.ActiveSheet.Range("A5")    '// A5열부터 데이터 출력
        .CurrentRegion.Offset(1).ClearContents    '// 현재 존재하는 값을 전부 삭제      
       
        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

               sRow = Cells(Rows.Count, "A").End(3)(2).Row     '// 첫번째 값을 뿌릴 행의 값
           
            If Not (.BOF And .EOF) Then
                NoRecords = False
                .MoveFirst
                While Not .EOF
                    .MoveNext
                    RSCount = RSCount + 1   '// 전체 레코드수 구하기
                Wend        '// 주어진 조건이 True인 동안은 일련의 문을 계속 실행
            Else
                NoRecords = True
                MsgBox ("가져올 자료가 없음")
                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
    DBconn.Close
    Set RS = Nothing
    Set DBconn = Nothing
   
    MsgBox RSCount & "개 데이터 가져오기 완료"
End Sub

블로그 이미지

Link2Me

,