ADO를 사용하여 Excel 스프레드 시트를 배열로 더 빨리 가져 오는 방법

Question

Excel 2007 VBA를 사용하여 큰 Excel 보고서의 데이터를 새 파일로 가져오고 정렬하려고합니다./동일한 파일에 배열과 출력에 새로운 시트 상에 배열의 모든 데이터를 수집 및 저장,

1. 유무 Excel에서 실제로 파일 (아래 코드)를 엽니 다 : 나는 지금까지이 작업을 수행하는 두 가지 방법으로 올라와있다 닫아.

   Public Sub GetData() 
   
       Dim FilePath As String 
   
       FilePath = "D:\File_Test.xlsx" 
       Workbooks.OpenText Filename:=FilePath, FieldInfo:=Array(Array(2, 2)) 
       ActiveWorkbook.Sheets(1).Select 
   
   End Sub 
   

2. 사용 ADO는 폐쇄 된 통합 문서에서 모든 데이터를 얻을 새 통합 문서로 거기에서 데이터를 다음 출력 데이터를 배열 (아래 코드)로 전체 데이터 시트를 가져 와서 정렬하고 저장/저를 닫습니다.

   Private Sub PopArray() 'Uses ADO to populate an array that will be used to sort data 
       Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset 
       Dim Getvalue, SourceRange, SourceFile, dbConnectionString As String 
   
       SourceFile = "D:\File_Test.xlsx" 
       SourceRange = "B1:Z180000" 
   
       dbConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ 
       "Data Source=" & SourceFile & ";" & _ 
       "Extended Properties=""Excel 12.0 Xml;HDR=No"";" 
       Set dbConnection = New ADODB.Connection 
       dbConnection.Open dbConnectionString 'open the database connection 
   
       Set rs = dbConnection.Execute("SELECT * FROM [" & SourceRange & "]") 
       Arr = rs.GetRows 
   
       UpBound = UBound(Arr, 2) 
       rs.Close 
   End Sub 
   

사용되는 테스트 파일 (나는 그것을 사용하게 될지 대략 세 번째)을 통해 정렬에 대한 65000 기록을 가지고있다. ADO 버전이 열린 워크 시트 (44 초 ~ 40 초 실행 시간)보다 약간 성능이 좋을 때 나는 실망했습니다. ADO 가져 오기 방법 (또는 전혀 다른 방법 - ExecuteExcel4Macro 어쩌면?)이 향상되면 내 속도가 향상 될지 궁금합니다. 내가 생각할 수있는 유일한 것은 을 최대 범위로 사용하여 Arr = rs.GetRows을 정확하게 잘라내어 총 레코드 수를 정확하게 나타 내기 위해 내 SourceRange을 최대 범위로 사용하고 있다는 것입니다. 그것이 느린 원인을 일으키는 것이라면 시트에 몇 개의 행이 있는지 찾는 방법을 모르겠습니다.

편집 - 범위 ("A1 : A"& i) = (배열)을 사용하여 새 워크 시트에 데이터를 삽입합니다.

Answer 1

이 답변은 찾고있는 것이 아니지만 사이드 노트 [...] 또는 완전히 다른 방법]을 기반으로 글을 올리도록 강요 받았습니다.].

여기서는 분리 문자를 포함하는 텍스트 파일 인 200MB 이상의 파일로 작업하고 있습니다. 더 이상 Excel에로드하지 않습니다. 또한 Excel이 너무 느리고 전체 파일을로드해야하는 문제가있었습니다. 그러나, 엑셀은 Open 방법을 사용하여 이러한 파일을 여는에서 매우 빠릅니다 :

Open strFileNameAndPath For Input Access Read Lock Read As #intPointer 

이 경우 Excel에서 전체 파일을로드하지 않고 단순히 라인으로 라인을 읽고. 따라서 Excel은 이미 데이터를 처리 (전달)하고 다음 데이터 행을 가져올 수 있습니다. 이 엑셀처럼 200 메가 바이트를로드하기 위해 메모리를 조정하지 않습니다.

이 방법을 사용하면 DWH (SQL)에 직접 데이터를 전송하는 로컬에 설치된 SQL에 데이터를로드합니다. 위의 방법을 사용하여 전송 속도를 높이고 SQL 서버로 데이터를 빠르게 가져 오려면 데이터를 각각 1000 행 단위로 전송합니다. Excel의 문자열 변수는 최대 20 억자를 포함 할 수 있습니다. 그래서 거기에는 문제가 없습니다.

SQL의 로컬 설치를 이미 사용하고있는 경우 SSIS를 사용하지 않는 이유가 궁금 할 수 있습니다. 그러나 문제는 내가이 모든 파일을 더 이상로드하지 않는다는 것입니다. Excel을 사용하여이 "가져 오기 도구"를 생성하면이 도구를 다른 사용자에게 전달할 수있게되었습니다. 다른 사용자는이 파일을 모두 업로드합니다. SSIS에 모든 액세스 권한을 부여하는 것은 선택 사항이 아니며 이러한 파일을 배치 할 수있는 대상 네트워크 드라이브를 사용할 가능성도 없으며 SSIS는 자동으로 SSIS를로드합니다 (10 분 이상).

결국 내 코드는 다음과 유사합니다.

Set conRCServer = New ADODB.Connection 
conRCServer.ConnectionString = "PROVIDER=SQLOLEDB; " _ 
    & "DATA SOURCE=" & Ref.Range("C2").Value2 & ";" _ 
    & "INITIAL CATALOG=" & Ref.Range("C4").Value & ";" _ 
    & "Integrated Security=SSPI " 
On Error GoTo SQL_ConnectionError 
conRCServer.Open 
On Error GoTo 0 

'Save the name of the current file 
strCurrentFile = ActiveWorkbook.Name 

'Prepare a dialog box for the user to pick a file and show it 
' ...if no file has been selected then exit 
' ...otherwise parse the selection into it's path and the name of the file 
Call Application.FileDialog(msoFileDialogOpen).Filters.Clear 
Call Application.FileDialog(msoFileDialogOpen).Filters.Add("Extracts", "*.csv") 
Application.FileDialog(msoFileDialogOpen).Title = "Select ONE Extract to import..." 
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False 
intChoice = Application.FileDialog(msoFileDialogOpen).Show 
If intChoice <> 0 Then 
    strFileToPatch = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) 
Else 
    Exit Sub 
End If 

'Open the Extract for import and close it afterwards 
intPointer = FreeFile() 
Open strFileNameAndPath For Input Access Read Lock Read As #intPointer 

intCounter = 0 
strSQL = vbNullString 
Do Until EOF(intPointer) 
    Line Input #intPointer, strLine 
    If Left(strLine, 4) = """@@@" Then Exit Sub 
    '********************************************************************* 
    '** Starting a new SQL command 
    '********************************************************************* 
    If intCounter = 0 Then 
     Set rstResult = New ADODB.Recordset 
     strSQL = "set nocount on; " 
     strSQL = strSQL & "insert into dbo.tblTMP " 
     strSQL = strSQL & "values " 
    End If 
    '********************************************************************* 
    '** Transcribe the current line into SQL 
    '********************************************************************* 
    varArray = Split(strLine, ",") 
    strSQL = strSQL & " (" & varArray(0) & ", " & varArray(1) & ", N'" & varArray(2) & "', " 
    strSQL = strSQL & " N'" & varArray(3) & "', N'" & varArray(4) & "', N'" & varArray(5) & "', " 
    strSQL = strSQL & " N'" & varArray(6) & "', " & varArray(8) & ", N'" & varArray(9) & "', " 
    strSQL = strSQL & " N'" & varArray(10) & "', N'" & varArray(11) & "', N'" & varArray(12) & "', " 
    strSQL = strSQL & " N'" & varArray(13) & "', N'" & varArray(14) & "', N'" & varArray(15) & "'), " 
    '********************************************************************* 
    '** Execute the SQL command in bulks of 1.000 
    '********************************************************************* 
    If intCounter >= 1000 Then 
     strSQL = Mid(strSQL, 1, Len(strSQL) - 2) 
     rstResult.ActiveConnection = conRCServer 
     On Error GoTo SQL_StatementError 
     rstResult.Open strSQL 
     On Error GoTo 0 
     If Not rstResult.EOF And Not rstResult.BOF Then 
      strErrorMessage = "The server returned the following error message(s):" & Chr(10) 
      While Not rstResult.EOF And Not rstResult.BOF 
       strErrorMessage = Chr(10) & strErrorMessage & rstResult.Fields(0).Value 
       rstResult.MoveNext 
      Wend 
      MsgBox strErrorMessage & Chr(10) & Chr(10) & "Aborting..." 
      Exit Sub 
     End If 
    End If 
    intCounter = intCounter + 1 
Loop 

Close intPointer 

Set rstResult = Nothing 

Exit Sub 

SQL_ConnectionError: 
Y = MsgBox("Couldn't connect to the server. Please make sure that you have a working internet connection. " & _ 
      "Do you want me to prepare an error-email?", 52, "Problems connecting to Server...") 
If Y = 6 Then 
    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 
    With OutMail 
     .To = Ref.Range("C7").Value2 
     .CC = Ref.Range("C8").Value2 
     .Subject = "Problems connecting to database '" & Ref.Range("C4").Value & "' on server '" & Ref.Range("C2").Value & "'" 
     .HTMLBody = "<span style=""font-size:10px"">---Automatically generated Error-Email---" & _ 
       "</span><br><br>Error report from the file '" & _ 
       "<span style=""color:blue"">" & ActiveWorkbook.Name & _ 
       "</span>' located and saved on '<span style=""color:blue"">" & _ 
       ActiveWorkbook.Path & "</span>'.<br>" & _ 
       "Excel is not able to establish a connection to the server. Technical data to follow." & "<br><br>" & _ 
       "Computer Name: <span style=""color:green;"">" & Environ("COMPUTERNAME") & "</span><br>" & _ 
       "Logged in as:  <span style=""color:green;"">" & Environ("USERDOMAIN") & "/" & Environ("USERNAME") & "</span><br>" & _ 
       "Domain Server: <span style=""color:green;"">" & Environ("LOGONSERVER") & "</span><br>" & _ 
       "User DNS Domain: <span style=""color:green;"">" & Environ("USERDNSDOMAIN") & "</span><br>" & _ 
       "Operating System: <span style=""color:green;"">" & Environ("OS") & "</span><br>" & _ 
       "Excel Version: <span style=""color:green;"">" & Application.Version & "</span><br>" & _ 
       "<br><span style=""font-size:10px""><br>" & _ 
       "<br><br>---Automatically generated Error-Email---" 
     .Display 
    End With 
    Set OutMail = Nothing 
    Set OutApp = Nothing 
End If 
Exit Sub 

SQL_StatementError: 
Y = MsgBox("There seems to be a problem with the SQL Syntax in the programming. " & _ 
      "May I send an error-email to development team?", 52, "Problems with the coding...") 
If Y = 6 Then 
    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 
    With OutMail 
     .To = Ref.Range("C8").Value2 
     '.CC = "" 
     .Subject = "Problems with the SQL Syntax in file '" & ActiveWorkbook.Name & "'." 
     .HTMLBody = "<span style=""font-size:10px"">" & _ 
       "---Automatically generated Error-Email---" & _ 
       "</span><br><br>" & _ 
       "Error report from the file '" & _ 
       "<span style=""color:blue"">" & _ 
       ActiveWorkbook.Name & _ 
       "</span>" & _ 
       "' located and saved on '" & _ 
       "<span style=""color:blue"">" & _ 
       ActiveWorkbook.Path & _ 
       "</span>" & _ 
       "'.<br>" & _ 
       "It seems that there is a problem with the SQL-Code within trying to upload an extract to the server." & _ 
       "SQL-Code causing the problems:" & _ 
       "<br><br><span style=""color:green;"">" & _ 
       strSQL & _ 
       "</span><br><br><span style=""font-size:10px"">" & _ 
       "---Automatically generated Error-Email---" 
     .Display 
    End With 
    Set OutMail = Nothing 
    Set OutApp = Nothing 
End If 
Exit Sub 

End Sub 

Answer 2

나는 @

Private Sub PopArray() 
    ..... 
    Set rs = dbConnection.Execute("SELECT * FROM [" & SourceRange & "]") 
    '' This is faster 
    Range("A1").CopyFromRecordset rs 
    ''Arr = rs.GetRows 
End Sub 

하지만 여전히 Arrays을 사용하려는 경우 당신이 시도 할 수 :

Sub ArrayTest 

'' Array for Test 
Dim aSingleArray As Variant 
Dim aMultiArray as Variant 

'' Set values 
aSingleArray = Array("A","B","C","D","E") 
aMultiArray = Array(aSingleArray, aSingleArray) 

'' You can drop data from the Array using 'Resize' 
'' Btw, your Array must be transpose to use this :P 
Range("A1").Resize(_ 
      UBound(aMultiArray(0), 1) + 1, _ 
      UBound(aMultiArray, 1) + 1) = Application.Transpose(aMultiArray) 

End Sub