0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

EXCEL フォルダ内にある複数ブックのシート結合

Posted at

フォルダ内にある複数のブックからシートを読み取り結合します。

参照設定

  • Microsoft Office*.* Object Library
  • Microsoft Scripting Runtime

コード

Option Explicit

Const TARGET_SHEET_NAME As String = "結合したいシート名"
Const RESULT_SHEET_NAME As String = "結果出力用の新規シート名"
Const NOT_NULL_COLUMN As Long = 1
Const IS_WINDOW_VISIBLE As Boolean = False

Public Sub CombineFile()
    
    If existSheet(ThisWorkbook, RESULT_SHEET_NAME) Then
        MsgBox "既に[" & RESULT_SHEET_NAME & "]シートが存在します"
        Exit Sub
    End If
    
    Dim resultSheet As Worksheet
    Set resultSheet = Worksheets.Add()
    resultSheet.Name = RESULT_SHEET_NAME
    
    Dim targetFolderPath As String
    Dim fd As FileDialog
    
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .InitialFileName = ThisWorkbook.Path & "\"
        If .Show = True Then
            targetFolderPath = .SelectedItems(1) & "\"
        Else
            MsgBox "フォルダが選択されませんでした"
            Exit Sub
        End If
    End With
        
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim startRow As Long
    Dim lastRow As Long

    Application.ScreenUpdating = False
    startRow = 2

    Dim fso As FileSystemObject
    Dim f As File
    
    Set fso = New FileSystemObject
    For Each f In fso.GetFolder(targetFolderPath).Files
        If LCase(fso.GetExtensionName(f.Name)) Like "xls*" Then
            Set wb = Workbooks.Open(Filename:=f.Path)
            Windows(wb.Name).Visible = IS_WINDOW_VISIBLE
            
            If existSheet(wb, TARGET_SHEET_NAME) Then
                Set ws = wb.Worksheets(TARGET_SHEET_NAME)
                With ws
                    If .AutoFilterMode Then
                        If .AutoFilter.FilterMode Then
                            .AutoFilterMode = False
                        End If
                    End If
                    
                    lastRow = GetLastRow(NOT_NULL_COLUMN, ws)
                    
                    If startRow = 2 Then
                        .Range(.Rows(1), .Rows(lastRow)).Cells.Copy
                        With resultSheet
                            .Range(.Rows(startRow - 1), .Rows(startRow + lastRow - 2)).PasteSpecial
                        End With
                    Else
                        .Range(.Rows(2), .Rows(lastRow)).Cells.Copy
                        With resultSheet
                            .Range(.Rows(startRow), .Rows(startRow + lastRow - 2)).PasteSpecial
                        End With
                    End If
                End With
                
                startRow = startRow + lastRow - 1
                
                Application.DisplayAlerts = False
                wb.Close
                Application.DisplayAlerts = True
                Set ws = Nothing
                Set wb = Nothing
            End If
        End If
    Next f
    
    Set fso = Nothing
    resultSheet.Cells(1, 1).Select
    Application.ScreenUpdating = True

End Sub

Private Function existSheet(wb As Workbook, sheetName As String) As Boolean
    Dim ws As Worksheet
    Dim ef As Boolean
    
    ef = False
    For Each ws In wb.Worksheets
        If ws.Name = sheetName Then
            ef = True
            Exit For
        End If
    Next
    
    existSheet = ef
End Function

Public Function GetLastRow(Optional ColumnNum As Long = 1, Optional ThisSheet As Worksheet) As Long
    If ThisSheet Is Nothing Then
        Set ThisSheet = ActiveSheet
    End If
    With ThisSheet
        GetLastRow = .Cells(.Rows.CountLarge, ColumnNum).End(xlUp).Row
    End With
End Function

定数

  • TARGET_SHEET_NAME:各ブックにある結合したいシート名
  • RESULT_SHEET_NAME:結果出力用の新規シート名
  • NOT_NULL_COLUMN : 必ず値が入っている列番号(最終行を判定するために使用)
  • IS_WINDOW_VISIBLE :ループ処理の際、対象ワークブックの表示設定(Trueで表示)
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?