VBAを用いたCSVおよびExcelシートの自動インポート

2025年2月19日

はじめに

このプロジェクトでは、VBAを用いてフォルダ内のCSVおよびExcel（xlsx、xlsm）ファイルを自動的にインポートし、1つのExcelブックに統合しました。本記事では、コードの詳細な解説を行います。

ソースコード

Sub ReadFiles()
    Dim folderPath As String
    Dim targetWb As Workbook
    
    Application.ScreenUpdating = False
    
    ' 現在のブックを取得
    Set targetWb = ThisWorkbook
    
    ' CSVやExcelファイルが含まれるフォルダを指定
    folderPath = SelectFolder()
    If folderPath = "" Then Exit Sub
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    ' CSVファイルの読み込み
    Call ReadCsvFiles(folderPath, targetWb)
    
    ' Excelファイルの読み込み（xlsx, xlsm）
    Call ReadExcelSheets(folderPath, targetWb, "*.xlsx")
    Call ReadExcelSheets(folderPath, targetWb, "*.xlsm")

    ' シートのスクロールリセット＆先頭シートのアクティブ化
    Call ResetScrollAndActivateFirstSheet(targetWb)
    
    Application.ScreenUpdating = True

    MsgBox "CSVおよびExcelシートのインポートが完了しました。", vbInformation
End Sub

' CSVファイルの読み込み関数
Sub ReadCsvFiles(folderPath As String, targetWb As Workbook)
    Dim fileName As String
    Dim sheetName As String
    Dim counter As Integer
    
    ' CSVファイルの読み込み
    fileName = Dir(folderPath & "*.csv")
    Do While fileName <> ""
        sheetName = Left(fileName, InStrRev(fileName, ".") - 1)
        counter = 1
        
        ' 同名シートがあればリネーム
        Do While SheetExists(sheetName, targetWb)
            sheetName = sheetName & "_" & counter
            counter = counter + 1
        Loop
        
        ' 新規シート作成＆CSVデータ読み込み
        On Error Resume Next
        Sheets(sheetName).Delete ' 同名が残っている場合に対応
        On Error GoTo 0
        With Sheets.Add(After:=Sheets(Sheets.Count))
            .Name = sheetName
            With .QueryTables.Add(Connection:="TEXT;" & folderPath & fileName, Destination:=.Range("A1"))
                .TextFileParseType = xlDelimited
                .TextFileCommaDelimiter = True
                .TextFilePlatform = 65001 ' UTF-8エンコード
                .TextFileConsecutiveDelimiter = False
                .TextFileTrailingMinusNumbers = True
                .TextFileColumnDataTypes = Array(1)
                .Refresh BackgroundQuery:=False
            End With
        End With
        
        Debug.Print "CSV読み込み完了: " & sheetName
        fileName = Dir
    Loop
End Sub

' Excelファイルの読み込み関数（xlsx, xlsm）
Sub ReadExcelSheets(folderPath As String, targetWb As Workbook, filePattern As String)
    Dim fileName As String
    Dim sourceWb As Workbook
    Dim ws As Worksheet
    Dim sheetName As String
    Dim counter As Integer
    
    fileName = Dir(folderPath & filePattern)
    Do While fileName <> ""
        On Error Resume Next
        Set sourceWb = Workbooks.Open(folderPath & fileName)
        If sourceWb Is Nothing Then
            Debug.Print "Excelファイルを開けませんでした: " & fileName
            fileName = Dir
            GoTo NextFile
        End If
        On Error GoTo 0
        
        Debug.Print "Excelファイル読み込み中: " & fileName
        
        ' シートをコピーして名前付け
        For Each ws In sourceWb.Sheets
            sheetName = sourceWb.Name & "_" & ws.Name
            sheetName = Replace(sheetName, Replace(filePattern, "*", ""), "")
            counter = 1
            Do While SheetExists(sheetName, targetWb)
                sheetName = sheetName & "_" & counter
                counter = counter + 1
            Loop
            
            ' シートをコピー
            ws.Copy After:=targetWb.Sheets(targetWb.Sheets.Count)
            targetWb.Sheets(targetWb.Sheets.Count).Name = sheetName
            Debug.Print "シートコピー完了: " & sheetName
        Next ws
        
        sourceWb.Close SaveChanges:=False
NextFile:
        fileName = Dir
    Loop
End Sub

' シートが存在するかを確認する関数
Function SheetExists(sheetName As String, wb As Workbook) As Boolean
    Dim ws As Worksheet
    SheetExists = False
    For Each ws In wb.Sheets
        If ws.Name = sheetName Then
            SheetExists = True
            Exit Function
        End If
    Next ws
End Function

' フォルダ選択ダイアログを表示する関数
Function SelectFolder() As String
    Dim folderPicker As FileDialog
    Set folderPicker = Application.FileDialog(msoFileDialogFolderPicker)
    
    With folderPicker
        .Title = "インポートするフォルダを選択してください"
        If .Show = -1 Then
            SelectFolder = .SelectedItems(1)
        Else
            SelectFolder = ""
        End If
    End With
End Function

    ' 全シートのスクロール位置をリセットし、最初のシートをアクティブにする関数
    Sub ResetScrollAndActivateFirstSheet(targetWb As Workbook)
        Dim ws As Worksheet
        ' 各シートのA1を選択し、スクロール位置をリセットし、列幅を自動調整
        For Each ws In targetWb.Sheets
            ws.Activate
            ' セルA1を選択してスクロール位置をリセット
            ws.Cells(1, 1).Select
            ActiveWindow.ScrollRow = 1
            ActiveWindow.ScrollColumn = 1
            
            ' 列幅を自動調整
            ws.Cells.EntireColumn.AutoFit
        Next ws
        
        ' 最初のシートをアクティブにする
        If targetWb.Sheets.Count > 0 Then
            targetWb.Sheets(1).Activate
        Else
            MsgBox "シートが存在しません。", vbExclamation
        End If
    End Sub

メインプロシージャ

マクロの実行準備

最初に Application.ScreenUpdating = False に設定し、画面の更新を停止します。
これにより、処理速度が向上し、画面のチラつきを防ぎます。

Application.ScreenUpdating = False

次に、現在のブックをターゲットとして設定します。

Set targetWb = ThisWorkbook

フォルダの選択

ユーザーに対して、ファイルが含まれるフォルダを選択させます。

folderPath = SelectFolder()
If folderPath = "" Then Exit Sub
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"

SelectFolder() はフォルダ選択のための関数（FileDialog を使用するのが一般的）。
ユーザーがフォルダを選ばなかった場合（folderPath = ""）、マクロを終了。
フォルダパスの末尾に \ をつけることで、パスの統一性を確保。

CSVファイルの読み込み

ReadCsvFiles(folderPath, targetWb) を呼び出し、フォルダ内のすべてのCSVファイルを読み込みます。

Call ReadCsvFiles(folderPath, targetWb)

この関数では、フォルダ内の *.csv ファイルを検索し、それぞれを現在のブックの新しいシートに取り込む処理を実行します。

Excelファイル（.xlsx, .xlsm）の読み込み

Excelファイルの読み込みには、ReadExcelSheets を使用します。

Call ReadExcelSheets(folderPath, targetWb, "*.xlsx")
Call ReadExcelSheets(folderPath, targetWb, "*.xlsm")

ReadExcelSheets(folderPath, targetWb, "*.xlsx") は .xlsx ファイルの読み込みを担当。
ReadExcelSheets(folderPath, targetWb, "*.xlsm") は .xlsm（マクロ付きExcelファイル）の読み込みを担当。

これにより、フォルダ内のすべてのExcelファイルを開き、それぞれのシートを取り込むことができます。

シートのスクロールリセット＆最初のシートをアクティブ化

すべてのシートのスクロール位置をリセットし、最初のシートをアクティブにします。

Call ResetScrollAndActivateFirstSheet(targetWb)

これにより、マクロ実行後の操作がしやすくなります。

処理完了の通知

最後に、処理が完了したことをユーザーに通知するメッセージを表示します。

MsgBox "CSVおよびExcelシートのインポートが完了しました。", vbInformation

フォルダ選択ダイアログ

フォルダ選択ダイアログの表示

VBAの FileDialog を使用して、フォルダ選択ダイアログを開きます。

Dim folderPicker As FileDialog
Set folderPicker = Application.FileDialog(msoFileDialogFolderPicker)

FileDialog(msoFileDialogFolderPicker) を使用すると、フォルダ選択専用のダイアログを表示できます。
folderPicker という変数に FileDialog オブジェクトを格納します。

フォルダ選択ダイアログの設定

フォルダ選択ダイアログのタイトルを設定します。

With folderPicker
    .Title = "インポートするフォルダを選択してください"

.Title にタイトルを設定することで、ユーザーにフォルダ選択の目的を明示できます。

ユーザーの選択を処理

ユーザーがフォルダを選択したかどうかを判定し、結果を返します。

If .Show = -1 Then
    SelectFolder = .SelectedItems(1)
Else
    SelectFolder = ""
End If

.Show = -1 の場合、ユーザーがフォルダを選択したことを意味します。
SelectedItems(1) を使用して、選択されたフォルダのパスを取得します。
ユーザーがキャンセルボタンを押した場合は、空の文字列 ("") を返します。

CSVファイルの読み込み

CSVファイルの検索

フォルダ内のCSVファイルを検索します。

fileName = Dir(folderPath & "*.csv")

Dir(folderPath & "*.csv") を使用して、フォルダ内のCSVファイルを取得。
Do While fileName <> "" のループ内で、すべてのCSVファイルを順番に処理。

シート名の設定と重複チェック

シート名をCSVファイル名から取得し、重複する場合はリネームします。

sheetName = Left(fileName, InStrRev(fileName, ".") - 1)
counter = 1

Do While SheetExists(sheetName, targetWb)
    sheetName = sheetName & "_" & counter
    counter = counter + 1
Loop

Left(fileName, InStrRev(fileName, ".") - 1) で拡張子を除いたファイル名を取得。
SheetExists(sheetName, targetWb) で同名のシートが存在するかチェック。
同名シートがある場合、_1, _2 のように番号を付加してリネーム。

新規シート作成とCSVデータの読み込み

取得したCSVデータを新規シートに読み込みます。

On Error Resume Next
Sheets(sheetName).Delete ' 同名が残っている場合に対応
On Error GoTo 0
With Sheets.Add(After:=Sheets(Sheets.Count))
    .Name = sheetName
    With .QueryTables.Add(Connection:="TEXT;" & folderPath & fileName, Destination:=.Range("A1"))
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .TextFilePlatform = 65001 ' UTF-8エンコード
        .TextFileConsecutiveDelimiter = False
        .TextFileTrailingMinusNumbers = True
        .TextFileColumnDataTypes = Array(1)
        .Refresh BackgroundQuery:=False
    End With
End With

Sheets(sheetName).Delete で、万が一同名のシートがあれば削除。
Sheets.Add(After:=Sheets(Sheets.Count)) で新しいシートを追加。
QueryTables.Add を使用して、CSVファイルをデータとして挿入。
TextFilePlatform = 65001 を指定することで、UTF-8エンコードのCSVにも対応。
.Refresh BackgroundQuery:=False でデータを即座に反映。

処理完了の確認

デバッグ用に、CSVファイルの読み込みが完了したことを出力します。

Debug.Print "CSV読み込み完了: " & sheetName
fileName = Dir

Debug.Print を使用して、読み込んだシート名をイミディエイトウィンドウに表示。
fileName = Dir で、次のCSVファイルを処理。

Excelファイルの読み込み

Excelファイルの検索とオープン

フォルダ内の対象となるExcelファイルを検索し、開きます。

fileName = Dir(folderPath & filePattern)
Do While fileName <> ""
    On Error Resume Next
    Set sourceWb = Workbooks.Open(folderPath & fileName)
    If sourceWb Is Nothing Then
        Debug.Print "Excelファイルを開けませんでした: " & fileName
        fileName = Dir
        GoTo NextFile
    End If
    On Error GoTo 0

Dir(folderPath & filePattern) を使用して、指定のファイルパターンに一致するExcelファイルを検索。
Workbooks.Open(folderPath & fileName) でExcelファイルを開く。
エラー処理を入れ、開けなかった場合はスキップ。
デバッグ出力で、開けなかったファイルを記録。

シートのコピーと名前の重複チェック

開いたExcelファイルのすべてのシートを現在のブックにコピーし、名前を調整します。

For Each ws In sourceWb.Sheets
    sheetName = sourceWb.Name & "_" & ws.Name
    sheetName = Replace(sheetName, Replace(filePattern, "*", ""), "")
    counter = 1
    Do While SheetExists(sheetName, targetWb)
        sheetName = sheetName & "_" & counter
        counter = counter + 1
    Loop

sourceWb.Name & "_" & ws.Name をシート名として設定。
SheetExists(sheetName, targetWb) で同名のシートがあるかチェック。
重複する場合は _1, _2 のように番号を付加。

シートのコピー処理

シートをコピーして、新しいシート名を設定します。

ws.Copy After:=targetWb.Sheets(targetWb.Sheets.Count)
targetWb.Sheets(targetWb.Sheets.Count).Name = sheetName
Debug.Print "シートコピー完了: " & sheetName

ws.Copy After:=targetWb.Sheets(targetWb.Sheets.Count) で、現在のブックの最後にシートをコピー。
コピー後に sheetName を設定。
デバッグ出力でコピー完了を記録。

ファイルを閉じて次の処理へ

処理が完了したら、開いたExcelファイルを閉じます。

sourceWb.Close SaveChanges:=False
NextFile:
    fileName = Dir
Loop

sourceWb.Close SaveChanges:=False で保存せずに閉じる。
fileName = Dir で次のExcelファイルを処理。

シートの存在確認

指定したシート名がブック内に存在するかを確認します。

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

For Each ws In wb.Sheets を使用して、指定した wb（ブック）のすべてのシートをループ処理。
If ws.Name = sheetName Then で、シート名が一致した場合は True を返す。
Exit Function で、マッチした時点で処理を終了し、無駄なループを回避。
ループが終了しても見つからなければ、False を返す。

スクロールリセットとシートのアクティブ化

シートのスクロール位置リセットと列幅調整

すべてのシートのA1セルを選択し、スクロール位置をリセットします。

Sub ResetScrollAndActivateFirstSheet(targetWb As Workbook)
    Dim ws As Worksheet
    ' 各シートのA1を選択し、スクロール位置をリセットし、列幅を自動調整
    For Each ws In targetWb.Sheets
        ws.Activate
        ' セルA1を選択してスクロール位置をリセット
        ws.Cells(1, 1).Select
        ActiveWindow.ScrollRow = 1
        ActiveWindow.ScrollColumn = 1
        
        ' 列幅を自動調整
        ws.Cells.EntireColumn.AutoFit
    Next ws

For Each ws In targetWb.Sheets を使用して、ブック内のすべてのシートをループ。
ws.Activate で対象のシートをアクティブにする。
ws.Cells(1, 1).Select でA1セルを選択し、スクロール位置をリセット。
ActiveWindow.ScrollRow = 1、ActiveWindow.ScrollColumn = 1 でスクロール位置を左上に移動。
ws.Cells.EntireColumn.AutoFit で列幅を自動調整。

最初のシートをアクティブにする

すべてのシートの処理が終わった後、最初のシートをアクティブにします。

    ' 最初のシートをアクティブにする
    If targetWb.Sheets.Count > 0 Then
        targetWb.Sheets(1).Activate
    Else
        MsgBox "シートが存在しません。", vbExclamation
    End If
End Sub

targetWb.Sheets(1).Activate で最初のシートをアクティブに。
If targetWb.Sheets.Count > 0 で、シートが存在しない場合は警告メッセージを表示。

実行結果

フォルダ選択後、CSVおよびExcelシートが自動的にインポートされました。
シート名の重複は回避され、すべてのデータが1つのExcelブックに統合されました。
シートごとのスクロール位置や列幅が適切に調整され、データの確認が容易になりました。

これにより、手作業でのデータインポート作業を効率的に自動化できました。

よかったらシェアしてね！

URLをコピーしました！

URLをコピーしました！

この記事を書いた人

Katsuma

VBAを用いたCSVおよびExcelシートの自動インポート

はじめに

ソースコード

メインプロシージャ

マクロの実行準備

フォルダの選択

CSVファイルの読み込み

Excelファイル（.xlsx, .xlsm）の読み込み

シートのスクロールリセット＆最初のシートをアクティブ化

処理完了の通知

フォルダ選択ダイアログ

フォルダ選択ダイアログの表示

フォルダ選択ダイアログの設定

ユーザーの選択を処理

CSVファイルの読み込み

CSVファイルの検索

シート名の設定と重複チェック

新規シート作成とCSVデータの読み込み

処理完了の確認

Excelファイルの読み込み

Excelファイルの検索とオープン

シートのコピーと名前の重複チェック

シートのコピー処理

ファイルを閉じて次の処理へ

シートの存在確認

シートの存在確認

スクロールリセットとシートのアクティブ化

シートのスクロール位置リセットと列幅調整

最初のシートをアクティブにする

実行結果

この記事を書いた人

コメント

コメントするコメントをキャンセル

VBAを用いたCSVおよびExcelシートの自動インポート

はじめに

ソースコード

メインプロシージャ

マクロの実行準備

フォルダの選択

CSVファイルの読み込み

Excelファイル（.xlsx, .xlsm）の読み込み

シートのスクロールリセット＆最初のシートをアクティブ化

処理完了の通知

フォルダ選択ダイアログ

フォルダ選択ダイアログの表示

フォルダ選択ダイアログの設定

ユーザーの選択を処理

CSVファイルの読み込み

CSVファイルの検索

シート名の設定と重複チェック

新規シート作成とCSVデータの読み込み

処理完了の確認

Excelファイルの読み込み

Excelファイルの検索とオープン

シートのコピーと名前の重複チェック

シートのコピー処理

ファイルを閉じて次の処理へ

シートの存在確認

シートの存在確認

スクロールリセットとシートのアクティブ化

シートのスクロール位置リセットと列幅調整

最初のシートをアクティブにする

実行結果

この記事を書いた人

関連記事

コメント

コメントする コメントをキャンセル

コメントするコメントをキャンセル