web-dev-qa-db-ja.com

何百ものExcelスプレッドシートファイルをマージするにはどうすればよいですか？

すべて同じ形式のExcelファイルが数百あります（Excelファイルごとに4つのワークシート）。すべてのファイルを1つに統合して、元のファイルと同じ形式のすべての歌と踊りのファイルにする必要があります（つまり、すべて同じ名前の4つの個別のワークシートを維持します）。

各ファイルの構造は同じですが、たとえばシート1と2の間の列（および見出し名）の数は異なります。したがって、1つのファイルにすべてを1つのシートにまとめることはできません。

2つの複雑な問題があります。

  1. ソースファイル（「ファイル名」）を識別するために、マージされたファイル（各シート上）にEXTRA列を作成する必要があります。

  2. ファイルには、マージされたファイルから削除する必要がある多くのゼロデータエントリ（たとえば、55行の有用なデータとそれに続く数百行のゼロ）が含まれています。

私はVBAを使用したことがありませんが、誰もが私が思うところから始めなければなりません。

microsoft-excelmerge
7
Jonathan de Mille

それはあなたが持っている強力な要求ですが、私は燃やす夜があったので、ここに私が動作すると思ういくつかのコードがあります。 （あなたのシートのフォーマットを知らなくても役に立ちませんが、これから作業することができます。）

新しいワークブック（これがマスターワークブックになります）を開き、VBA環境（Alt + F11）に移動して、新しいモジュールを作成します（挿入>モジュール）。次のVBAコードを新しいモジュールウィンドウに貼り付けます。

Option Explicit
Const NUMBER_OF_SHEETS = 4

Public Sub GiantMerge()
    Dim externWorkbookFilepath As Variant
    Dim externWorkbook As Workbook
    Dim i As Long
    Dim mainLastEnd(1 To NUMBER_OF_SHEETS) As Range
    Dim mainCurEnd As Range

    Application.ScreenUpdating = False

    ' Initialise

    ' Correct number of sheets
    Application.DisplayAlerts = False
    If ThisWorkbook.Sheets.Count < NUMBER_OF_SHEETS Then
        ThisWorkbook.Sheets.Add Count:=NUMBER_OF_SHEETS - ThisWorkbook.Sheets.Count
    ElseIf ThisWorkbook.Sheets.Count > NUMBER_OF_SHEETS Then
        For i = ThisWorkbook.Sheets.Count To NUMBER_OF_SHEETS + 1 Step -1
            ThisWorkbook.Sheets(i).Delete
        Next i
    End If
    Application.DisplayAlerts = True

    For i = 1 To NUMBER_OF_SHEETS
        Set mainLastEnd(i) = GetTrueEnd(ThisWorkbook.Sheets(i))
    Next i


    ' Load the data
    For Each externWorkbookFilepath In GetWorkbooks()
        Set externWorkbook = Application.Workbooks.Open(externWorkbookFilepath, , True)

        For i = 1 To NUMBER_OF_SHEETS

            If mainLastEnd(i).Row > 1 Then
                ' There is data in the sheet

                ' Copy new data (skip headings)
                externWorkbook.Sheets(i).Range("A2:" & GetTrueEnd(externWorkbook.Sheets(i)).Address).Copy ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row + 1, 1)

                ' Find the end column and row
                Set mainCurEnd = GetTrueEnd(ThisWorkbook.Sheets(i))
            Else
                ' No nata in sheet yet (prob very first run)

                ' Get correct sheet name from first file we check
                ThisWorkbook.Sheets(i).Name = externWorkbook.Sheets(i).Name

                ' Copy new data (with headings)
                externWorkbook.Sheets(i).Range("A1:" & GetTrueEnd(externWorkbook.Sheets(i)).Address).Copy ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row, 1)

                ' Find the end column and row
                Set mainCurEnd = GetTrueEnd(ThisWorkbook.Sheets(i)).Offset(, 1)

                ' Add file name heading
                ThisWorkbook.Sheets(i).Cells(1, mainCurEnd.Column).Value = "File Name"
            End If

            ' Add file name into extra column
            ThisWorkbook.Sheets(i).Range(ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row + 1, mainCurEnd.Column), mainCurEnd).Value = externWorkbook.Name

            Set mainLastEnd(i) = mainCurEnd
        Next i

        externWorkbook.Close
    Next externWorkbookFilepath

    Application.ScreenUpdating = True
End Sub

' Returns a collection of file paths, or an empty collection if the user selects cancel
Private Function GetWorkbooks() As Collection
    Dim fileNames As Variant
    Dim xlFile As Variant

    Set GetWorkbooks = New Collection

    fileNames = Application.GetOpenFilename(Title:="Please choose the files to merge", _
                                               FileFilter:="Excel Files, *.xls;*.xlsx", _
                                               MultiSelect:=True)
    If TypeName(fileNames) = "Variant()" Then
        For Each xlFile In fileNames
            GetWorkbooks.Add xlFile
        Next xlFile
    End If
End Function

' Finds the true end of the table (excluding unused columns/rows and rows filled with 0's)
Private Function GetTrueEnd(ws As Worksheet) As Range
    Dim lastRow As Long
    Dim lastCol As Long
    Dim r As Long
    Dim c As Long

    On Error Resume Next
    lastCol = ws.UsedRange.Find("*", , , xlPart, xlByColumns, xlPrevious).Column
    lastRow = ws.UsedRange.Find("*", , , xlPart, xlByRows, xlPrevious).Row
    On Error GoTo 0

    If lastCol <> 0 And lastRow <> 0 Then

        ' look back through the last rows of the table, looking for a non-zero value
        For r = lastRow To 1 Step -1
            For c = 1 To lastCol
                If ws.Cells(r, c).Text <> "" Then
                    If ws.Cells(r, c).Text <> 0 Then
                        Set GetTrueEnd = ws.Cells(r, lastCol)
                        Exit Function
                    End If
                End If
            Next c
        Next r
    End If

    Set GetTrueEnd = ws.Cells(1, 1)
End Function

保存すると、使用を開始する準備が整います。

マクロGiantMergeを実行します。マージするExcelファイルを選択する必要があります（通常のウィンドウの方法で、ダイアログボックスで複数のファイルを選択できます（Ctrlキーを押して複数の個別ファイルを選択し、Shiftキーを押してファイルの範囲を選択します）。マージするすべてのファイルでマクロを実行する必要はありません。一度に数個だけ実行できます。初めて実行すると、マスターブックが正しい数のシートを持つように構成され、マージするために選択した最初のブックに基づいてシートに名前が付けられ、見出しに追加されます。

私は以下の仮定をしました（完全なリストではありません）：

  • 4枚あります（コード上部の定数を変更することで簡単に変更できます。）
  • シートはすべての追加ワークブックで同じ順序になっています
  • 各シートの列は、すべてのワークブックで同じ順序になっています（ただし、ワークブックのすべてのシートに同じ列があるわけではありません。たとえば、WorkBook1、Sheet1には列A、B、Cがあり、Sheet2には列A、Bがあります。WorkBook2、Sheet1列A、B、C、シート2には列A、Bがあります。ワークブックに次のような場合：シート1には列A、C、B、シート2には列B、Aがあり、列は正しく配置されません）
  • 余分なワークブックに余分な列や欠落している列がない
  • 各ワークブックのすべてのシートに見出し行があります（各シートの最初の行にのみあります）
  • すべての列を含める必要があります（0のみが含まれている場合でも）
  • 0のみを含むテーブルの最後のすべての行はマスターにコピーされません
  • 追加の列で必要なのはファイル名のみで（ファイルパスではありません）
  • 一部のシートにデータがない場合（またはそれらがゼロで埋められている場合）、どの程度うまくいくかわかりません。

お役に立てれば。

14
Chris Kent

また、Ron de BruinがRDBMergeと呼ばれるExcelワークシートをマージするための素晴らしいWindowsプラグインを作成したことにも言及する価値があります。手順はここにあります： http://www.rondebruin.nl/merge.htm 。 Excel 2007でxlsxファイルをマージすることで、問題なく動作しました。

ソースファイルの名前を含むマージされたファイルに追加の列を作成します。ただし、ゼロデータエントリ（元の質問の2番目の部分）の処理方法はわかりません。

2
Per Quested Aronsson

これらのExcelファイルをマージするだけのツールが必要な場合は、 JMC Excel を確認してください。

1
JeeShen Lee

単純なpythonスクリプトを使用するメソッド（VBよりもはるかに短い！））。

https://superuser.com/a/1138948/141182

0
abalter
Sub simpleXlsMerger()
    Dim bookList As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    Application.ScreenUpdating = False
    Set mergeObj = CreateObject("Scripting.FileSystemObject")

    ' change folder path of Excel files here
    Set dirObj = mergeObj.Getfolder("D:\change\to\Excel\files\path\here")
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
        Set bookList = Workbooks.Open(everyObj)

        ' change "A2" with cell reference of start point for every files here
        ' for example "B3:IV" to merge all files start from columns B and rows 3 
        ' If you're files using more than IV column, change it to the latest column
        ' Also change "A" column on "A65536" to the same column as start point
        Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(1).Activate

        ' Do not change the following column. It's not the same column as above
        Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
        Application.CutCopyMode = False
        bookList.Close
    Next
End Sub
0
Olufemi

これはまともなサイズのプロジェクトですが、非常に実行可能です。ここに、構築できるVBAの良いスタートがあります。これにより、1つのフォルダーにファイルを（単独で）持っている場合に、マージする必要があるすべてのファイルを確認できます。マージするマスタブックは、このディレクトリに存在してはなりません。

Option Explicit
Sub giantmerge()
    Dim f As Object, fso As Object
    Dim folder As String
    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
    Dim sn1 As String, sn2 As String, sn3 As String, sn4 As String
    Set wb = ThisWorkbook
    'Change sheet names to match those in your workbooks.
    sn1 = "Sheet1"
    sn2 = "Sheet2"
    sn3 = "Sheet3"
    sn4 = "Sheet4"
    Set ws1 = wb.Sheets(sn1)
    Set ws2 = wb.Sheets(sn2)
    Set ws3 = wb.Sheets(sn3)
    Set ws4 = wb.Sheets(sn4)

    Set fso = CreateObject("Scripting.FileSystemObject")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        If .SelectedItems.Count = 0 Then
            MsgBox "Cancel Selected"
            End
        End If
        folder = .SelectedItems(1)
    End With
    For Each f In fso.GetFolder(folder).Files
        Workbooks.Open Filename:=f.Path
        'Get data and store in temporary arrays.
        Workbooks(f.Name).Close
        'Input data in this workbook (master).
    Next
End Sub

これで、あなた（または他の誰か）が最後にForループのコードを提供できます。お役に立てれば。

0
Excellll