프로그램 저렴하게 제작해드립니다. 문의) 카톡 : vbnvba

'Excel & vba'에 해당되는 글 4건

2016.01.17 [vba] 엑셀에서 여러개의 텍스트파일 읽어오기
2016.01.11 [vba] Microsoft.ACE.OLEDB.12.0를 이용한 특정시트를 query
2016.01.08 [vba] Page Up/Page Down 버튼을 이용한 시트이동 단축키
2016.01.07 [vba] ListObjects(QueryTable)를 이용한 엑셀 열지않고 데이터 가지고옴

2016. 1. 17. 21:58

[vba] 엑셀에서 여러개의 텍스트파일 읽어오기

엑셀에서 vba를 이용하여 여러개의 텍스트파일을 읽어올 일이 있습니다.

주석도 같이 달아 두었습니다.

Sub ImportTxtFile()
    Dim fPath As Variant, T As String, i As Integer, tmp() As Byte, FN As Integer
    fPath = Application.GetOpenFilename("Text Files (*.txt),*.txt", , "텍스트파일 선택", MultiSelect:=True)    '복수선택 가능
    If TypeName(fPath) = "Boolean" Then Exit Sub    '// 취소버튼 또는 파일이 선택되지 않으면 프로시져 종료
    For i = 1 To UBound(fPath)  '// 선택한 파일을 을 순환하면서
        FN = FreeFile   '// 파일번호 할당
        ReDim tmp(FileLen(fPath(i)) - 1) As Byte    '// 바이트배열 크기
        Open fPath(i) For Binary As #FN '// 파일을 바이너리로 열음
            Get #FN, , tmp  '// 바이트 배열에 담음
        Close #FN   '// 파일을 닫음
        If Len(T) Then T = T & vbNewLine    '// 변수가 비어있지 않으면 줄바꿈을 넣음
        T = T & StrConv(tmp, vbUnicode) '// 바이트를 텍스트로 변환해서 T변수에 추가
    Next    '// 다음파일 진행
    fPath = Split(T, vbNewLine) '// 얻어온 텍스트를 줄바꿈으로 분리
    Cells.Clear '// 시트의 셀을 초기화
    [A1].Resize(UBound(fPath) + 1).Value = Application.Transpose(fPath) '// 시트에 내용을 뿌림
End Sub

이 포스팅은 쿠팡 파트너스 활동으로, 일정액의 커미션을 제공받고 있습니다.

Posted by vbnvba

2016. 1. 11. 10:11

[vba] Microsoft.ACE.OLEDB.12.0를 이용한 특정시트를 query

Excel & vba/Query

출처 :: http://cafe.naver.com/xlsvba/21087

'================================================================================================
' Procedure   : GetRecordsetThisworkbook
' Description : Microsoft.ACE.OLEDB.12.0를 이용한 특정시트를 query
' Author      : Evinious
' Parameter   : xSql : 쿼리문
'               shtName : 출력 시트명
'               targetRange : 출력시트내 시작셀
' MS-SQL에서 EXCEL파일을 쿼리하는 용도로 많이 쓰임

sp_configure 'show advanced options', 1;

RECONFIGURE;

sp_configure 'Ad Hoc Distributed Queries', 1;

RECONFIGURE;

EXEC master.dbo.sp_MSset_oledb_prop N'Microsoft.ACE.OLEDB.4.0', N'AllowInProcess', 1

EXEC master.dbo.sp_MSset_oledb_prop N'Microsoft.ACE.OLEDB.4.0', N'DynamicParameters', 1

EXEC master.dbo.sp_MSset_oledb_prop N'Microsoft.ACE.OLEDB.12.0', N'AllowInProcess', 1

EXEC master.dbo.sp_MSset_oledb_prop N'Microsoft.ACE.OLEDB.12.0', N'DynamicParameters', 1

-- excel 2007 이상

INSERT INTO DB내_대상_테이블명

SELECT *

FROM OPENROWSET

('Microsoft.ACE.OLEDB.12.0',

'Excel 12.0 Xml;HDR=YES;Database=C:\test\TEST.xlsx;'

,'SELECT * FROM [TblMenu$]')

-- excel 2003 이하

INSERT INTO DB내_대상_테이블명

SELECT *

FROM OPENROWSET

('Microsoft.ACE.OLEDB.12.0',

'Excel 8.0;HDR=YES;Database=C:\test\TEST.xls;'

,'SELECT * FROM [TblMenu$]')

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
'================================================================================================
Public Sub GetRecordsetThisworkbook(ByVal xSql As String, _
                                    ByVal shtName As String, _
                                    ByRef targetRange As Range)
    Dim oCn As Object
    Dim oRs As Object
    Dim wb As Workbook
    
    Set oCn = CreateObject("ADODB.Connection")    With oCn
        .Provider = "Microsoft.ACE.OLEDB.12.0;"
        .ConnectionString = "Data Source=" & ThisWorkbook.FullName & _
                            ";Extended Properties=""Excel 12.0 Xml;"";"
        .ConnectionTimeout = 10
        .Open
    End With
    
    Set oRs = CreateObject("ADODB.recordset")
    
    oRs.Open xSql, oCn, 1
  
    ThisWorkbook.Sheets(shtName).Cells.ClearContents
        
    targetRange.CopyFromRecordset oRs
    
'    Debug.Print oRs.RecordCount
    
    oRs.Close
    oCn.Close
    
    Set oRs = Nothing
    Set oCn = Nothing
    
    '## 여러개의 workbook 존재시
    For Each wb In Application.Workbooks
        Debug.Print wb.Name
        If wb.Name = ThisWorkbook.Name And wb.ReadOnly Then
            Debug.Print wb.Name
        End If
    Next
    
End Sub
Sub Test()
    Dim xSql As String
    
    xSql = "SELECT LEFT(UBT, 5) AS UBT, SUM(IDT) AS IDT " & vbCrLf & _
           "  FROM [RAW$] " & vbCrLf & _
           " WHERE IDT > 20000 GROUP BY LEFT(UBT, 5)"    GetRecordsetThisworkbook xSql, "ret", ThisWorkbook.Worksheets("ret").Range("A1")
End Sub

이 포스팅은 쿠팡 파트너스 활동으로, 일정액의 커미션을 제공받고 있습니다.

Posted by vbnvba

2016. 1. 8. 09:30

[vba] Page Up/Page Down 버튼을 이용한 시트이동 단축키

Excel & vba

Page Up/Page Down 버튼으로 시트를 이동합니다.

Dim i As Integer
Dim setTime As Double
 
Sub Auto_Open()
    Application.OnKey "{PGDN}", "DN"
    Application.OnKey "{PGUP}", "UP"
End Sub
 
Sub DN()
    If setTime > Timer Then Exit Sub
    i = ActiveSheet.Index
    i = i - 1
    If i < 1 Then i = 1
    Sheets(i).Activate
    setTime = Timer + 1 / 3
End Sub
 
Sub UP()
    If setTime > Timer Then Exit Sub
    i = ActiveSheet.Index
    i = i + 1
    If i > Sheets.Count Then i = Sheets.Count
    Sheets(i).Activate
    setTime = Timer + 1 / 3
End Sub

'Excel & vba' 카테고리의 다른 글

[vba] ListObjects(QueryTable)를 이용한 엑셀 열지않고 데이터 가지고옴 (0)	2016.01.07

이 포스팅은 쿠팡 파트너스 활동으로, 일정액의 커미션을 제공받고 있습니다.

Posted by vbnvba

2016. 1. 7. 09:11

[vba] ListObjects(QueryTable)를 이용한 엑셀 열지않고 데이터 가지고옴

Excel & vba

시트단위로 값을 가지고 오는것이 흠이기는 하지만 나름 꽤 쓸만한 기능중 하나라고 봅니다.

'// Excel파일을 열지않고 시트로 불러옴
Sub ET(FullPath As String)
    Sheets("QueryTables").Cells.Delete Shift:=xlUp
    Dim Source As String
    Source = Source & "OLEDB;"
    Source = Source & "Provider=Microsoft.ACE.OLEDB.12.0;"
'    Source = Source & "Password="""";"
'    Source = Source & "User ID=Admin;"
    Source = Source & "Data Source=" & FullPath & ";"
'    Source = Source & "Mode=Share Deny Write;"
'    Source = Source & "Extended Properties=""HDR=YES;"";"
'    Source = Source & "Jet OLEDB:System database="""";"
'    Source = Source & "Jet OLEDB:Registry Path="""";"
'    Source = Source & "Jet OLEDB:Database Password="""";"
    Source = Source & "Jet OLEDB:Engine Type=37;"
'    Source = Source & "Jet OLEDB:Database Locking Mode=0;"
'    Source = Source & "Jet OLEDB:Global Partial Bulk Ops=2;"
'    Source = Source & "Jet OLEDB:Global Bulk Transactions=1;"
'    Source = Source & "Jet OLEDB:New Database Password="""";"
'    Source = Source & "Jet OLEDB:Create System Database=False;"
'    Source = Source & "Jet OLEDB:Encrypt Database=False;"
'    Source = Source & "Jet OLEDB:Don't Copy Locale on Compact=False;"
'    Source = Source & "Jet OLEDB:Compact Without Replica Repair=False;"
'    Source = Source & "Jet OLEDB:SFP=False;"
'    Source = Source & "Jet OLEDB:Support Complex Data=False"
 
 
    With Sheets("QueryTables").ListObjects.Add(SourceType:=0, Source:=Source, Destination:=Sheets("QueryTables").Range("$A$1")).QueryTable
        .CommandType = xlCmdTable    '//
        .CommandText = Array("Sheet1$")    '//
'        .RowNumbers = False
'        .FillAdjacentFormulas = False
'        .PreserveFormatting = True
'        .RefreshOnFileOpen = False
'        .BackgroundQuery = True
'        .RefreshStyle = xlInsertDeleteCells
'        .SavePassword = False
'        .SaveData = True
'        .AdjustColumnWidth = True
'        .RefreshPeriod = 0
'        .PreserveColumnInfo = True
        .SourceDataFile = FullPath    '//
'        .ListObject.DisplayName = "표"
        .Refresh BackgroundQuery:=False    '//
    End With
End Sub