Dir関数を利用し、選択したフォルダの中のCSVファイル群を読み込んで1つのシートにコピーする
今回は、Dir関数を利用して、フォルダの中のCSVファイル群を列挙して１つのシートにコピーする方法を作成します。
CSVファイルにヘッダーが存在する場合は、最初のファイルを読み込んだデータはヘッダー付き、それ以外は2行目からのデータをシートに貼り付けします。
ヘッダーが存在しない場合は、全てのデータをシートに貼り付けします。
CSVファイルを列挙して読み込み1つのシートに書き込む関数を利用するには、列挙したCSVファイルデータをコピーして貼り付けするためのシート名を追加しておく必要があります。
|
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 66 67 68 |
Function CSVファイルを列挙して読み込み1つのシートに書き込む(strFolder As String, nHeader As Long, strSheetName As String) As Boolean Dim strFile As String Dim wb As Workbook Dim ws As Worksheet Dim nEndRow As Long Dim nEndRow2 As Long Dim nEndColumn2 As Long ' Excelの確認メッセージなし・イベントなし・描写なし・自動計算なし・カーソルを砂時計 Application.DisplayAlerts = False Application.EnableEvents = False Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.Cursor = xlWait ' strSheetNameシートのセルをクリアする ThisWorkbook.Worksheets(strSheetName).Cells.Clear If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\" End If ' フォルダにあるCSVファイルを読み込み、１つのシートに書き込む strFile = Dir(strFolder & "*.csv") Do While strFile <> "" ' CSVファイルを読み込む Set wb = Workbooks.Open(strFolder & strFile) Set ws = wb.Sheets(1) ' このワークブックのdataシートの最後の行を取得 nEndRow = ThisWorkbook.Worksheets(strSheetName).Cells(Rows.Count, 1).End(xlUp).Row ' CSVファイルの最後の行と列を取得 nEndRow2 = ws.Cells(Rows.Count, 1).End(xlUp).Row nEndColumn2 = ws.Cells(1, Columns.Count).End(xlToLeft).Column ' CSVファイルのデータをコピーし ' strSheetNameシートが空白の場合は1行目に貼り付け ' 空白でない場合は最後の行の次の行に貼り付け If nEndRow = 1 Then ws.Range(ws.Cells(1, 1), ws.Cells(nEndRow2, nEndColumn2)).Copy ThisWorkbook.Sheets(strSheetName).Cells(nEndRow, 1) Else ws.Range(ws.Cells(1 + nHeader, 1), ws.Cells(nEndRow2, nEndColumn2)).Copy ThisWorkbook.Sheets(strSheetName).Cells(nEndRow + 1, 1) End If CSVファイルを列挙して読み込み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ファイルを列挙したいフォルダを設定します。
nHeader:ヘッダーがある場合は1、ない場合は0を設定します。
strSheetName:列挙したCSVファイルのデータを貼り付けするためのシートを設定します。
使用例
C2セルにフォルダが入っています。
C2セルのフォルダを初期設定として、「フォルダを選択する」関数に渡しています。
次に、選択したフォルダとパラメータを設定し、「CSVファイルを列挙して読み込み1つのシートに書き込む」関数に渡しています。
今回の例は、15行目でヘッダーなし、シート名を「data」を設定して、列挙したファイルのデータを「data」シートにコピーするようにしています。
|
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 |
Sub フォルダを選択する_Click() Dim strFolder As String Dim bRet As Boolean strFolder = Range("c2") strFolder = フォルダを選択する(strFolder) Range("c2") = strFolder Dim i As Long ' ファイルを列挙する If strFolder <> "" Then bRet = CSVファイルを列挙して読み込み1つのシートに書き込む(strFolder, 0, "data") 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 |