동일한 양식의 여러 엑셀파일 취합

시트명과 구조가 같은 엑셀파일들의 취합

월보할 때 좋겠네 ^^

원래는 Open구문으로 작업했는데

ADO와 배열을 사용해서 속도에 중점을 두었다.

Option Explicit
Private vBody(20, 6) As Variant
Sub sumFiles()
 
    Dim wsName As String
    Dim rngName As Range
    Dim strPath As String
    Dim fileName As String
 
    '처리속도 향상
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
 
    '변수설정 및 기존자료 삭제
    wsName = "현황"
    Set rngName = Range("D16:J36")
    rngName.ClearContents
 
    '데이터 불러올 폴더 선택
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        If .SelectedItems.Count = 0 Then
            Exit Sub
        Else
            strPath = .SelectedItems(1) & "\"
        End If
    End With

    '엑셀파일을 변수에 넣고 폴더에 엑셀파일이 없으면 매크로 종료
    fileName = Dir(strPath & "*.xls*")
    If fileName = "" Then Exit Sub

    '폴더 내 파일 순환
    Do While fileName <> ""

        'ADO로 파일 불러오기
        bring_Data strPath & fileName, wsName, rngName.Address(0, 0)
        fileName = Dir
    Loop

    '각 셀별로 합한 자료를 입력 후 배열 초기화
    rngName = vBody
    Erase vBody

    '처리속도 복구
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub


'ADO로 자료 가져오기
Private Sub bring_Data(varFile As Variant, strSht As String, rngD As String)

    Dim objCon As New ADODB.Connection
    Dim objData As New ADODB.Recordset
    Dim strConn As String
    Dim strSQL As String
    Dim vTemp() As Variant
    Dim r As Integer
    Dim c As Integer

    If Val(Application.Version) < 12 Then    '엑셀 2007 아래버전의 경우
        strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source=" & varFile & ";" & _
                    "Extended Properties=""Excel 8.0;HDR=NO"";"  '연결 생성
    Else                                                  '엑셀 2007 버전 이상인 경우
        strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & varFile & ";" & _
                    "Extended Properties=""Excel 12.0;HDR=NO"";"
    End If

    strSQL = "SELECT * FROM [" & strSht$ & "$" & rngD$ & "];"   '현황 시트의 D16:J36 데이터를 가져옴
    objCon.Open strConn
    objData.Open strSQL, objCon, 0, 1, 1
    vTemp = objData.GetRows '데이터를 배열에 삽입(행,열 바뀜에 주의)

    For r = 0 To 20
        For c = 0 To 6
            If vTemp(c, r) <> "" Then
                vBody(r, c) = Val(vBody(r, c)) + Val(vTemp(c, r))
            End If
        Next c
    Next r

    objData.Close   'Recordset을 닫음
    objCon.Close    '연결을 끊음
    Erase vTemp '배열초기화

End Sub

데이터 취합.xlsm

데이터1.xlsx

데이터2.xlsx

데이터3.xlsx