Dir関数を利用してフォルダの中のCSVファイル群を読み込み、1ファイル1シートとしてコピーする
前回は、Dir関数を利用して、フォルダの中のCSVファイル群を列挙し、１つのシートにコピーする方法を作成しました。
関連記事
Dir関数を利用し、選択したフォルダの中のCSVファイル群を読み込んで1つのシートにコピーする 今回は、Dir関数を利用して、フォルダの中のCSVファイル群を列挙して１つのシートにコピーする方法を作成します。 CSVファイルにヘッダ[…]
今回は、Dir関数を利用して、フォルダの中のCSVファイル群を列挙し、1ファイル1シートとしてコピーする方法を作成します。
シート名は31文字以上に設定できないため、列挙するファイル名はすべて31文字以下になっているかどうか確認する必要があります。
31文字以上のファイルが存在する場合、VBAで31文字以上のファイル名は31文字以下にするなどの処理を追加するとよいでしょう。
サンプルソースは以下です。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 |
Function ファイルを列挙しファイル毎のデータをシートに書き込む(strFolder As String) As Boolean Dim strFile As String Dim wb As Workbook Dim ws As Worksheet Dim strFileNoExt As String Dim nEndRow As Long Dim nEndColumn As Long ' フォルダの最後の文字が\でなかった場合、\を追加 If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\" End If ' Excelの確認メッセージなし・イベントなし・描写なし・自動計算なし・カーソルを砂時計 Application.DisplayAlerts = False Application.EnableEvents = False Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.Cursor = xlWait ' フォルダにあるCSVファイルを読み込み、１つのシートに書き込む strFile = Dir(strFolder & "*.csv") Do While strFile <> "" ' CSVファイルを読み込む Set wb = Workbooks.Open(strFolder & "\" & strFile) Set ws = wb.Sheets(1) ' シート名にするため、拡張子なしのファイル名を取得する strFileNoExt = Left(strFile, InStrRev(strFile, ".") - 1) ' シートを追加し、拡張子なしのファイル名をシート名にする ThisWorkbook.Activate ThisWorkbook.Worksheets.Add after:=Worksheets(ThisWorkbook.Worksheets.Count) ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = strFileNoExt ' CSVファイルの最後の行と列を取得する nEndRow = ws.Cells(Rows.Count, 1).End(xlUp).Row nEndColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column ' CSVファイルのデータを拡張子なしのファイル名シートにコピーする ws.Range(ws.Cells(1, 1), ws.Cells(nEndRow, nEndColumn)).Copy ThisWorkbook.Sheets(strFileNoExt).Cells(1, 1) ファイルを列挙しファイル毎のデータをシートに書き込む = True ' CSVファイルを閉じて解放する wb.Close Set ws = Nothing Set wb = Nothing ' 次のファイルを読み込む strFile = Dir() Loop ' Excelの確認メッセージあり・イベントあり・描写あり・自動計算あり・カーソルを普通に戻す Application.ScreenUpdating = True Application.EnableEvents = True Application.DisplayAlerts = True Application.Calculation = xlCalculationAutomatic Application.Cursor = xlDefault End Function |
関数の説明
strFolder:CSVファイルを列挙したいフォルダを設定します。
使用例
C2セルにフォルダが入ります。C3セルに「フォルダを選択する」ボタンを作成します。
C2セルのフォルダを設定するため、「フォルダを選択する」ボタンをクリックすることで「フォルダを選択する」関数に渡しています。
次に、設定したフォルダをパラメータとして、「ファイルを列挙しファイル毎のデータをシートに書き込む」関数に渡しています。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 |
Sub フォルダを選択する_Click() Dim strFolder As String Dim bRet As Boolean strFolder = Range("c2") strFolder = フォルダを選択する(strFolder) Range("c2") = strFolder Dim i As Long Dim nwsCount As Long Dim strWsName As String ' Sheet1以外のシートを削除する nwsCount = ThisWorkbook.Worksheets.Count For i = nwsCount To 1 Step -1 strWsName = ThisWorkbook.Worksheets(i).Name If strWsName <> "Sheet1" Then Application.DisplayAlerts = False ThisWorkbook.Worksheets(strWsName).Delete Application.DisplayAlerts = True End If Next i ' ファイルを列挙する If strFolder <> "" Then bRet = ファイルを列挙しファイル毎のデータをシートに書き込む(strFolder) End If MsgBox "書き込みを終了しました", vbInformation End Sub ' FileDialogを利用してフォルダを参照する Function フォルダを選択する(strFolder As String) If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\" End If With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = strFolder ' フォルダの初期値を設定 .Title = "フォルダを選択" If .Show = True Then フォルダを選択する = .SelectedItems(1) End If End With End Function |