「たくさんのExcelファイルから特定の数字の行を抜き出して、1つのExcelにまとめたい」
決まったフォーマットで複数のExcelファイルにデータがあり、各ファイルから必要なデータを収集して、1つのExcelに集約する作業は、仕事でよく発生します。
1つ1つのファイルを開いて、該当する部分をコピーして、Excelにペースト…単純だけど時間がかかる作業。
単純作業に時間が取られるのは、非常にもったいないし、非効率的。
そこで、このようなデータの集約は、ExcelのVBAで自動化して、作業をラクにしましょう。
【大量のExcelデータから特定のデータを抜き出して別のExcelブックに集約する】Excel VBAのコードを解説しています。
複数のExcelデータから必要なデータをExcelブックに集約するVBAマクロのコード
このVBAのコードは、指定したフォルダ内のExcelファイルから特定のデータを抽出し、ワークブックの特定のシートに転記するという処理を行います。
また、データ抽出が完了したファイルは別のフォルダに移動します。
データは、指定した文字列を探し出して、その文字列のセルを基準に決まった分だけ移動したセルから下までデータを抽出する操作を行います。
抽出するデータは２行です。
Option Explicit
Sub ExtractData()
' カスタマイズ可能なパラメータ
Dim opSheet As Worksheet: Set opSheet = ThisWorkbook.Sheets("operation")
Dim folderPath As String: folderPath = ThisWorkbook.Path & "\" & opSheet.Range("C2").Value & "\"
Dim CompletedFolderPath As String: CompletedFolderPath = ThisWorkbook.Path & "\" & opSheet.Range("C3").Value & "\"
Dim searchSheetName As String: searchSheetName = opSheet.Range("C4").Value
Dim SearchString As String: SearchString = opSheet.Range("C5").Value
Dim offsetRow As Integer: offsetRow = opSheet.Range("C6").Value
Dim offsetCol As Integer: offsetCol = opSheet.Range("C7").Value
Dim offsetRowForNextData As Integer: offsetRowForNextData = opSheet.Range("C8").Value
Dim offsetColForNextData As Integer: offsetColForNextData = opSheet.Range("C9").Value
' -------------------------
' パフォーマンスのために、画面更新をオフにし、計算モードをマニュアルに設定します
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' エラーハンドリングを開始します
On Error GoTo ErrorHandler
Dim FileName As String: FileName = Dir(folderPath)
Dim outputSheet As Worksheet: Set outputSheet = ThisWorkbook.Sheets("output")
Dim lowDataSheet As Worksheet: Set lowDataSheet = ThisWorkbook.Sheets("low data")
'シートのデータをすべて削除します
outputSheet.Cells.ClearContents
lowDataSheet.Cells.ClearContents
'該当のデータを探してシートにコピーします
Dim i As Integer: i = 0
Do While FileName <> ""
If FileName Like "*.xls*" Then
Dim wb As Workbook: Set wb = Workbooks.Open(folderPath & FileName)
Dim ws As Worksheet: Set ws = wb.Sheets(searchSheetName)
ws.UsedRange.Copy outputSheet.Cells(1, 1)
Dim searchCell As Range: Set searchCell = outputSheet.Cells.Find(SearchString)
If Not searchCell Is Nothing Then
Dim dataRange As Range
Set dataRange = outputSheet.Range(searchCell.Offset(offsetRow, offsetCol), outputSheet.Cells(outputSheet.Rows.Count, searchCell.Column).End(xlUp))
Dim dataArray As Variant: dataArray = dataRange.Value2
lowDataSheet.Cells(2, 1 + i * 2).Resize(dataRange.Rows.Count).Value = dataArray
Set dataRange = outputSheet.Range(searchCell.Offset(offsetRowForNextData, offsetColForNextData), outputSheet.Cells(outputSheet.Rows.Count, searchCell.Column + 1).End(xlUp))
dataArray = dataRange.Value2
lowDataSheet.Cells(2, 2 + i * 2).Resize(dataRange.Rows.Count).Value = dataArray
lowDataSheet.Cells(1, 1 + i * 2).Value = Left(FileName, (InStrRev(FileName, ".", -1, vbTextCompare) - 1))
End If
wb.Close False
' ファイルを完了フォルダに移動します
Name folderPath & FileName As CompletedFolderPath & FileName
End If
FileName = Dir
i = i + 1
Loop
' 画面更新と計算を再度有効にします
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ThisWorkbook.Save
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました: " & Err.Description
' エラーが発生した場合、画面更新と計算を再度有効にします
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Resume Next
End SubExcelブックの使い方
Excelブックの使い方を解説します。
Excelのopraionのシートに必要な情報を入力します。
読み込むデータの形式にあわせて、必要な情報を入力してください。
読み込むExcelを保存するフォルダ名には、データを保存するフォルダ名を入力してください、
読み込んだExcelを保存するファイル名には、処理が完了したファイルを保存するファイル名を入力してください。
読み込むExcelのシート名、読み込みたいExcelデータのシート名を入力します。
シートから探す文字列を入力します。
読み込むデータ1の開始位置 行は、読み込むデータの１行目の探した文字列から下にシフトする量を入力します。（整数のみ入力できます）
読み込むデータ1の開始位置 列は、読み込むデータの１行目の探した文字列から右にシフトする量を入力します。（整数のみ入力できます）
読み込むデータ2の開始位置 行は、読み込むデータの2行目の探した文字列から下にシフトする量を入力します。（整数のみ入力できます）
読み込むデータ2の開始位置 列は、読み込むデータの2行目の探した文字列から右にシフトする量を入力します。（整数のみ入力できます）
Excelを保存したフォルダに、データを保存するフォルダと処理が完了したデータを保存するフォルダを作成します。
処理したいExcelデータを、該当するフォルダに保存します。
コードの解説
【大量のExcelデータから特定のデータを抜き出して別のExcelブックに集約する】Excel VBAのコードを処理ごとに解説していきます。
この部分では、”operation”シートから各種パラメータを読み込んでいます。これには、検索するファイルとシートの名前、抽出するデータの位置などが含まれています。
カスタマイズ可能なパラメータ
Dim opSheet As Worksheet: Set opSheet = ThisWorkbook.Sheets("operation")
Dim folderPath As String: folderPath = ThisWorkbook.Path & "\" & opSheet.Range("C2").Value & "\"
Dim CompletedFolderPath As String: CompletedFolderPath = ThisWorkbook.Path & "\" & opSheet.Range("C3").Value & "\"
Dim searchSheetName As String: searchSheetName = opSheet.Range("C4").Value
Dim SearchString As String: SearchString = opSheet.Range("C5").Value
Dim offsetRow As Integer: offsetRow = opSheet.Range("C6").Value
Dim offsetCol As Integer: offsetCol = opSheet.Range("C7").Value
Dim offsetRowForNextData As Integer: offsetRowForNextData = opSheet.Range("C8").Value
Dim offsetColForNextData As Integer: offsetColForNextData = opSheet.Range("C9").Value
' -------------------------この部分では、パフォーマンスの向上のために、Excelの画面更新と計算を一時的に無効化しています。
これにより、各操作が即時に画面に反映されたり、各セルの計算が即時に行われることを防ぎ、全体の処理を高速化しています。
パフォーマンスのために、画面更新をオフにし、計算モードをマニュアルに設定します
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManualこの部分では、エラーハンドリングを開始しています。このコードは、後続のコードでエラーが発生した場合に、プログラムがErrorHandlerラベルにジャンプするように指示します。これにより、エラーが発生した際に適切なメッセージを表示し、必要なクリーンアップを行うことができます。
エラーハンドリングを開始します
On Error GoTo ErrorHandlerこの部分では、指定されたフォルダ内の各Excelファイルを開き、指定されたシートからデータをコピーしています。コピーしたデータはoutputSheetに一時的に保存されます。その後、特定の検索文字列を含むセルを探し、そのセルから指定されたオフセット位置のデータを抽出します。抽出したデータは、”low data”シートの適切な位置に貼り付けられます。
該当のデータを探してシートにコピーします
Dim i As Integer: i = 0
Do While FileName <> ""
If FileName Like "*.xls*" Then
Dim wb As Workbook: Set wb = Workbooks.Open(folderPath & FileName)
Dim ws As Worksheet: Set ws = wb.Sheets(searchSheetName)
ws.UsedRange.Copy outputSheet.Cells(1, 1)
...
End If
FileName = Dir
i = i + 1
Loopこの部分では、処理が完了したファイルを、指定された「完了」フォルダに移動しています。これにより、同じファイルが再度処理されることを防ぎます。
ファイルを完了フォルダに移動します
Name folderPath & FileName As CompletedFolderPath & FileNameこの部分では、先ほど無効化した画面更新と計算を再度有効にしています。これにより、Excelの通常の動作が再開されます。
画面更新と計算を再度有効にします
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomaticこの部分では、エラーハンドリングを終了しています。エラーが発生した場合には、エラーメッセージを表示し、画面の更新と計算を再度有効にします。その後、エラー発生位置の次の行から処理を再開します。
ErrorHandler:
MsgBox "エラーが発生しました: " & Err.Description
' エラーが発生した場合、画面更新と計算を再度有効にします
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Resume NextVBAコードの活用事例
実験データや売上のデータは、テキストファイルやExcelで出力されることが多いです。
実験や分析条件も記載されたたくさんのセルの中から、分析に必要なデータを抜き出す必要がありますが、手作業だと面倒で時間がかかります。
上記のExcel VBAのコードを使えば、この面倒なデータの出力作業を一瞬で終わらせることができます。
まとめ：VBAでデータ抽出の効率化
【大量のExcelデータから特定のデータを抜き出して別のExcelブックに集約する】Excel VBAのコードを解説でした。
プログラミングを使って、業務を自動化して、ラクして成果を出しましょう。
コメント