다른 시트 자료를 SQL 방식으로 가져오는 걸 지난번에 한번 해봤는데 네이버지식인에 올라온 문의사항을 보니 AutoFilter 를 이용하는 것보다 SQL 형태로 가져오면 좋겠다는 생각이 들어서 다시 한번 해봤다.
그러면서 SQL 조건에서 자료형식 체크하는 걸 추가했다.
내가 잘 몰라서인지 서식까지 그대로 복사를 하지 못했다.
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
'업무 능력 향상 > 엑셀 VBA 활용' 카테고리의 다른 글
영화자막 하이픈 처리 (0) | 2015.05.24 |
---|---|
[VBA] 중복제거 함수의 버그(?) (0) | 2015.05.22 |
[VBA] 환율 파싱 (0) | 2015.05.18 |
[VBA] 다른 엑셀 또는 다른 시트에서 SQL 로 데이터 가져오기 (0) | 2015.05.15 |
[VBA] 작업량 실적 그래프화 표시 (0) | 2015.05.14 |