Excel VBA:データ結合マクロ

2019年12月15日

データ結合用(Excel形式、CSV形式両対応)型つくりました。Pythonでも同機能のもの作成してみます。
修正:12/15 データが一つしかない場合読まない問題解決

標準モジュール:FileDataMerge <結合用プロシジャー>

'結合データ配列
Dim MargeDataList As Variant
'結合データのサイズ設定用
Dim MaxDataRows As Long
Dim MaxDataCols As Long
Sub データ結合()
'====================================
'【目的】フォルダー内の複数データの結合マクロ
'【バージョン】Ver1.0
'【対象ファイル】CSV,Xlsx,xls,xlsm
'【対応】Excel2007以降Excel
'【方針】基本作成中は配列上の作業とし最終シート書き出し行う/データの取扱いとデータの成型及びファイル出力は分ける
'【変数名規則】機能_個別名⇒例:Cnt_Data:データ数カウント
'【動作フロー】
'①作業前事前準備:現データバックアップ→設定表「A5:A15」から有効な項目のみ抽出
'②取込作業:フォルダー選択(設定している場合、初期値に指定フォルダー名表記)各データ配列取込→メインの配列に結合結合表の成型→ファイル名をタグする→フィルター設置
'③全体の結果を残す
'====================================
'条件設定用配列
Dim InstanceRule1 As New FileRule
Dim SettingList As Variant
Dim Flag_FileOK As Boolean
Dim Flag_RuleOK As Boolean
Dim Ck_Data As Date
Dim Ck_PickupStart As String
'基本用各宣言
Dim i, j, k
Dim Ck_Start As String
'代入用
Dim Temp_Path, Temp_File, Temp_Sheet As String
Dim Temp_StartRow, Temp_StartCol, Ct_File, Ct_Data As Long
'シートの有無判定
Dim Ck_WorkSheet As Worksheet
Dim Flag_SheetOK As Boolean
Dim Temp_Sheetname As String
Ck_PickupStart = MsgBox("データ結合作成", vbOKCancel)
If (Ck_PickupStart = vbCancel) Then '作業中断
    Exit Sub
End If
'===========①作業前事前準備============
'エラー時は強制終了
'On Error GoTo ErrorProcess
'アラームOFF
Application.DisplayAlerts = True
'自動計算OFF
Application.Calculation = xlCalculationManual
'シート固定
Application.ScreenUpdating = False
'作業前にバックアップ作成
Call Backup
'取込ルールの初期化
'設定取込
Sheets("設定画面").Select
    MargeDataList = Range("A1:B1")
    
    If (Range("A6") = "") Then 'データない場合中断
        Exit Sub
    Else
        'ダミー格納→すぐに解除する配列を決定づけるために作成
        SettingList = Range("A5:H15")  '取込データリスト
        Range("C1") = Format(Now, "yyyy/mm/dd hh:nn")  '取込日
        If (Range("F1") > 100) Then
            MaxDataRows = Range("F1") '最大データ数あれば格納
        Else
            MaxDataRows = 1000000 '最大データ数100以下もしくはない場合1000000代入
            Range("F1") = MaxDataRows '最大データ数表示
        End If
    End If
    For i = 2 To UBound(SettingList)  'シートの有無判定→ない場合新規に対応シート作成する
    If (SettingList(i, 1) <> "") Then
            Flag_SheetOK = False
            For Each Ck_WorkSheet In Worksheets
                If Ck_WorkSheet.Name = SettingList(i, 1) Then Flag_SheetOK = True
            Next Ck_WorkSheet
            If Flag_SheetOK = False Then
               'シートない場合追加→一番後ろに移動
                Worksheets.Add.Name = SettingList(i, 1)
                Worksheets(SettingList(i, 1)).Move After:=Worksheets(Worksheets.Count)
            End If
    End If
    Next i
'===========②設定条件に合わせてフォルダー内の情報を取込作成============
'各シートにデータ格納→メインルーチンは条件式からのフィルタ格納
'条件に沿うもののみクラスインスタンス作成
    For i = 2 To UBound(SettingList)
        '結合用配列の初期化
        Erase MargeDataList
        MaxDataCols = 0
        Set InstanceRule1 = New FileRule
        
        '条件クラス代入
        InstanceRule1.格納先シート = SettingList(i, 1)
        InstanceRule1.ファイル名規則 = SettingList(i, 2)
        If (InstanceRule1.格納先シート = "") Then
        
            'シートがない場合問答無用でスキップ
            
        ElseIf (InstanceRule1.ファイル名規則 Like "【無効】*" And InstanceRule1.格納先シート <> "") Then  'ファイル名ルールが無効ファイル名がない場合はスキップ
        
            SettingList(i, 2) = InstanceRule1.ファイル名規則  'ファイル名無効の旨記録
        
        Else  '無効なファイル名がない場合のみデータ格納開始
           InstanceRule1.フォルダーパス = SettingList(i, 8)
           If (InstanceRule1.フォルダーパス <> "") Then  '該当するフォルダーデータがあるときのみ作業する
              Sheets(InstanceRule1.格納先シート).Select   'データ格納用シート選択<不要な上書き避けるため先に移動>
               '設定条件読みだし
                    InstanceRule1.対象シート = SettingList(i, 3)
                    InstanceRule1.項目行番号 = SettingList(i, 4)
                    InstanceRule1.基準列番号 = SettingList(i, 5)
              '格納先情報の初期化
                  Cells.Select
                  Selection.Delete Shift:=xlUp
                  Range("A1").Select
               '記録カウンター読み出し
                    InstanceRule1.対象シート = SettingList(i, 3)
               
                '配列作成処理
                Temp_Path = InstanceRule1.フォルダーパス
                Temp_File = InstanceRule1.ファイル名規則
                Temp_Sheet = InstanceRule1.対象シート
                Temp_StartRow = InstanceRule1.項目行番号
                Temp_StartCol = InstanceRule1.基準列番号
                Ct_File = 0
                Ct_Data = 0
                If (Temp_File Like "*.csv") Then
                  Call 個別CSVデータ格納(Temp_Path, Temp_File, Temp_StartRow, Temp_StartCol, Ct_File, Ct_Data)
                ElseIf ((Temp_File Like "*.xls?" Or Temp_File Like "*.xls") And Temp_Sheet <> "") Then
                  Call 個別Excelデータ格納(Temp_Path, Temp_File, Temp_Sheet, Temp_StartRow, Temp_StartCol, Ct_File, Ct_Data)
                End If
                Ct_Row = 1
                InstanceRule1.データ数 = Ct_Data - 1
                InstanceRule1.ファイル数 = Ct_File
                InstanceRule1.フォルダーパス = Temp_Path
                'データ作成後→シート貼り付け→状況記録
                Sheets(InstanceRule1.格納先シート).Select
                
                If (Ct_Data > 1) Then
                Range(Cells(1, 1), Cells(Ct_Data, UBound(MargeDataList, 2))) = MargeDataList
                End If
                   
                    SettingList(i, 4) = InstanceRule1.項目行番号 '項目行位置設定
                    SettingList(i, 5) = InstanceRule1.基準列番号 '基準列位置設定
                    SettingList(i, 6) = InstanceRule1.データ数 'データ数
                    SettingList(i, 7) = InstanceRule1.ファイル数 'ファイル数格納
                    SettingList(i, 8) = InstanceRule1.フォルダーパス 'フォルダーパス格納
                '対象ファイルにフィルタ設置
                If (Range("B1") <> "") Then
                Range("A1").Select
                Range(Selection, Selection.End(xlToRight)).Select
                Selection.AutoFilter
                Range("A1").Select
                End If
            End If
        
        End If
        Set InstanceRule1 = Nothing  '条件クラス開放
    Next i
'===========③設定条件に合わせてフォルダー内の情報を取込作成============
Sheets("設定画面").Select
Range("A6:H15").ClearContents
Range("A5:H15") = SettingList
    
'シート固定解除
Application.ScreenUpdating = True
'自動計算ON
Application.Calculation = xlCalculationAutomatic
'アラームON
Application.DisplayAlerts = True
Exit Sub
ErrorProcess:
        MsgBox ("エラー発生、終了します")
End Sub
Sub 個別CSVデータ格納(Temp_Path, Temp_File, Temp_StartRow, Temp_StartCol, Ct_File, Ct_Data)
'フォルダー内の指定ファイル読みだして配列順次結合
'一番初めのファイルは項目列から読み出し→項目列数+1=Main_DataColとして格納→固定データ<最後の列はファイル名格納用>
'Main_DataRowも一番ははじめは項目行~最終行までMain_DataRowとする
'⇒2つ目のファイルからは項目行の次の行を基準にする。またもし項目業の次のデータがない場合処理スキップする'
'元のデータ
Dim Orignal_Data As Variant
Dim Ck_Orignal_DataRow As Long
Dim Ck_Orignal_DataCol As Long
'フォルダー操作用の宣言
Dim FSO As Object
Dim Orignal_DataFile, buf_DataFile As String
Dim ct_TempFile As Long
Dim FileTypeTag As String
Dim Flag_DataExist As Boolean
'基本用各宣言
Dim i, j, k
'エラー時は強制スキップ
On Error GoTo ErrorProcess
'シート固定
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'==①事前準備:取込前の初期設定(初期値入力+値が不正の場合スキップする)
'==②ファイル読み込み→シート及び項目行の次の行データがある場合、データ取込 、安全装置として
buf_DataFile = Dir(Temp_Path & "\" & Temp_File)  'ファイルデータ読み出し用中継データ
Do While buf_DataFile <> "" Or ct_TempFile > 100000
    ct_TempFile = ct_TempFile + 1 '無限ループ対策の安全弁
    'ファイル開いて配列格納
    Orignal_DataFile = Temp_Path & "\" & buf_DataFile
    If Orignal_DataFile <> "False" Then
        Workbooks.Open Orignal_DataFile  'ファイル開く
            '開いたファイルの中身判定→エクセルシートあるときのみ処理(CSVはそのまま処理)
            'データ判定用に最終行列抽出
            Ck_Orignal_DataRow = Cells(Rows.Count, Temp_StartCol).End(xlUp).Row 'オリジナルデータ行数
            Ck_Orignal_DataCol = Cells(Temp_StartRow, Columns.Count).End(xlToLeft).Column 'オリジナルデータ列数
            'データ格納
            If (Ck_Orignal_DataCol > Temp_StartCol And Ck_Orignal_DataRow > Temp_StartRow) Then
               Orignal_Data = Range(Cells(Temp_StartRow, Temp_StartCol), Cells(Ck_Orignal_DataRow, Ck_Orignal_DataCol))
            Else
               Orignal_Data = Range(Cells(1, 1), Cells(1, 1))
            End If
        ActiveWorkbook.Close 'ファイル閉じる
        If (UBound(Orignal_Data, 1) >= 2 And UBound(Orignal_Data, 2) > 0 And Ct_File = 0) Then '初期のファイルから核の配列作成
            MaxDataCols = UBound(Orignal_Data, 2) + 1
            ReDim MargeDataList(1 To MaxDataRows, 1 To MaxDataCols) '格納用結合配列の作成
            For i = 1 To MaxDataCols - 1
                MargeDataList(1, i) = Orignal_Data(1, i)
            Next i
                MargeDataList(1, MaxDataCols) = "取込元ファイル名"
            Ct_Data = Ct_Data + 1
            For i = 2 To UBound(Orignal_Data, 1)
            Ct_Data = Ct_Data + 1
                For j = 1 To MaxDataCols - 1
                    MargeDataList(Ct_Data, j) = Orignal_Data(i, j)
                Next j
                    MargeDataList(Ct_Data, MaxDataCols) = buf_DataFile
            Next i
            Ct_File = Ct_File + 1
        ElseIf (UBound(Orignal_Data, 1) >= 2 And UBound(Orignal_Data, 2) > 0 And Ct_File > 0) Then
            For i = 2 To UBound(Orignal_Data, 1)
            Ct_Data = Ct_Data + 1
                For j = 1 To MaxDataCols - 1
                    MargeDataList(Ct_Data, j) = Orignal_Data(i, j)
                Next j
                    MargeDataList(Ct_Data, MaxDataCols) = buf_DataFile
            Next i
            Ct_File = Ct_File + 1
        End If
    End If
    Erase Orignal_Data 'オリジナルデータ格納初期化
    buf_DataFile = Dir()
Loop
'シート固定
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
ErrorProcess:
End Sub
Sub 個別Excelデータ格納(Temp_Path, Temp_File, Temp_Sheet, Temp_StartRow, Temp_StartCol, Ct_File, Ct_Data)
'フォルダー内の指定ファイル読みだして配列順次結合
'一番初めのファイルは項目列から読み出し→項目列数+1=Main_DataColとして格納→固定データ<最後の列はファイル名格納用>
'Main_DataRowも一番ははじめは項目行~最終行までMain_DataRowとする
'⇒2つ目のファイルからは項目行の次の行を基準にする。またもし項目業の次のデータがない場合処理スキップする'
'元のデータ
Dim Orignal_Data As Variant
Dim Ck_Orignal_DataRow As Long
Dim Ck_Orignal_DataCol As Long
'フォルダー操作用の宣言
Dim FSO As Object
Dim Orignal_DataFile, buf_DataFile As String
Dim ct_TempFile As Long
Dim FileTypeTag As String
Dim Flag_DataExist As Boolean
'基本用各宣言
Dim i, j, k
'エラー時は強制スキップ
On Error GoTo ErrorProcess
'シート固定
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'==①事前準備:取込前の初期設定(初期値入力+値が不正の場合スキップする)
'==②ファイル読み込み→シート及び項目行の次の行データがある場合、データ取込 、安全装置として
buf_DataFile = Dir(Temp_Path & "\" & Temp_File)  'ファイルデータ読み出し用中継データ
Do While buf_DataFile <> "" Or ct_TempFile > 100000
    ct_TempFile = ct_TempFile + 1 '無限ループ対策の安全弁
    'ファイル開いて配列格納
    Orignal_DataFile = Temp_Path & "\" & buf_DataFile
    If Orignal_DataFile <> "False" Then
        Workbooks.Open Orignal_DataFile  'ファイル開く
            '開いたファイルの中身判定→エクセルシートあるときのみ処理(CSVはそのまま処理)
                        '開いたファイルの中身判定→エクセルシートあるときのみ処理
                Dim ws As Worksheet, flag As Boolean
                For Each ws In Worksheets
                    If ws.Name = Temp_Sheet Then flag = True
                Next ws
                If flag = True Then
                                     Flag_DataExist = True
                         Sheets(Temp_Sheet).Select
                'データ判定用に最終行列抽出
                    Ck_Orignal_DataRow = Cells(Rows.Count, Temp_StartCol).End(xlUp).Row 'オリジナルデータ行数
                    Ck_Orignal_DataCol = Cells(Temp_StartRow, Columns.Count).End(xlToLeft).Column 'オリジナルデータ列数
                    'データ格納
                    If (Ck_Orignal_DataCol > Temp_StartCol And Ck_Orignal_DataRow > Temp_StartRow) Then
                       Orignal_Data = Range(Cells(Temp_StartRow, Temp_StartCol), Cells(Ck_Orignal_DataRow, Ck_Orignal_DataCol))
                    Else
                       Orignal_Data = Range(Cells(1, 1), Cells(1, 1))
                    End If
                Else
                    Orignal_Data = Range(Cells(1, 1), Cells(1, 1))
                End If
                        
        ActiveWorkbook.Close 'ファイル閉じる
        If (UBound(Orignal_Data, 1) >= 2 And UBound(Orignal_Data, 2) > 0 And Ct_File = 0) Then '初期のファイルから核の配列作成
            MaxDataCols = UBound(Orignal_Data, 2) + 1
            ReDim MargeDataList(1 To MaxDataRows, 1 To MaxDataCols) '格納用結合配列の作成
            For i = 1 To MaxDataCols - 1
                MargeDataList(1, i) = Orignal_Data(1, i)
            Next i
                MargeDataList(1, MaxDataCols) = "取込元ファイル名"
            Ct_Data = Ct_Data + 1
            For i = 2 To UBound(Orignal_Data, 1)
            Ct_Data = Ct_Data + 1
                For j = 1 To MaxDataCols - 1
                    MargeDataList(Ct_Data, j) = Orignal_Data(i, j)
                Next j
                    MargeDataList(Ct_Data, MaxDataCols) = buf_DataFile
            Next i
            Ct_File = Ct_File + 1
        ElseIf (UBound(Orignal_Data, 1) >= 2 And UBound(Orignal_Data, 2) > 0 And Ct_File > 0) Then
            For i = 2 To UBound(Orignal_Data, 1)
            Ct_Data = Ct_Data + 1
                For j = 1 To MaxDataCols - 1
                    MargeDataList(Ct_Data, j) = Orignal_Data(i, j)
                Next j
                    MargeDataList(Ct_Data, MaxDataCols) = buf_DataFile
            Next i
            Ct_File = Ct_File + 1
        End If
    End If
    Erase Orignal_Data 'オリジナルデータ格納初期化
    buf_DataFile = Dir()
Loop
'シート固定
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
ErrorProcess:
End Sub
Sub Backup()
 
'エラー時は強制終了
On Error GoTo ErrorProcess
   
    Dim Ck_Backup As Integer
    Dim Backup_FileName, Backup_FolderPath, Backup_FilePath As String
    Dim Ck_BackupFolder
    
    
    Ck_Backup = MsgBox("バックアップを作成して保存します。よろしいですか?", vbYesNo)
    If Ck_Backup = vbNo Then Exit Sub
    
    Backup_FileName = "結合データBackup" & Format(Now, "_yyyymmddhhnn") & ".xlsm"
    Backup_FolderPath = ActiveWorkbook.Path & "\結合データBackup"
    
    Ck_BackupFolder = Dir(Backup_FolderPath, vbDirectory)
    
    If Ck_BackupFolder = "" Then 'フォルダが存在しない場合作成する
        MkDir Backup_FolderPath
    End If
   
   
    'Backup後の保存先
    Backup_FilePath = Backup_FolderPath & "\" & Backup_FileName
    
    ActiveWorkbook.SaveCopyAs Backup_FilePath  'Backup保存実行
    
Exit Sub
ErrorProcess:
        MsgBox ("エラー発生、終了します")
 
End Sub

標準モジュール:DataOutPut <出力用プロシジャー>

Sub データ出力()
 With CSV_OutPut.DataListBox1
 For i = 6 To 15
 If (Cells(i, 1) <> "") Then
 .AddItem Cells(i, 1)
 End If
 Next i
 End With
 CSV_OutPut.txtDate1 = Format(Range("C1"), "yyyymmdd-hhnn")
CSV_OutPut.Show
End Sub

クラスモジュール:FileRule<ファイル取込ルール格納用クラス>


'===============================
'ファイル結合用のファイルデータ確認用 クラスモジュール
'ファイル名判定機能とエラー時の判定機能はこのクラスにて確認
'===============================
'TR番号に対する条件のクラス,見分けつけるため「_」を最終文字に添付
    Private 格納先シート_ As String '格納先シート
    Private ファイル名規則_ As String 'ファイル名規則→xls?もしくはcsv拡張子無い場合ファイル名規則.無効にして無効とする
    Private 対象シート_ As String '対象シート(エクセルのみ)→CSVファイルを設定した場合"/対象シート不要/"←わざとシート名に使えない文字記入→これにより間違って読まない
    Private 項目行番号_ As Long '項目行番号 データの名前がある行 →記入がない場合1にする
    Private 基準列番号_ As Long '基準列番号 データの開始される列 →記入がない場合1にする
    Private フォルダーパス_ As String '建物種別切替
    Private データ数_ As Long 'データ数→初期値 0
    Private ファイル数_ As Long 'ファイル数→初期値 0
    Private 項目数_ As Long '書き込み先にデータがある場合そのまま格納 ない場合⇒該当データ読み出し作成
'「格納先シート」というプロパティの設定プロシージャ
Property Let 格納先シート(ByVal new_格納先シート As String)
  格納先シート_ = new_格納先シート
  End Property
'「格納先シート」というプロパティの取得プロシージャ
Property Get 格納先シート() As String
  格納先シート = 格納先シート_
End Property
'「ファイル名規則」というプロパティの設定プロシージャ、ファイル名規則がエクセルもしくはCSV形式でない場合無効
Property Let ファイル名規則(ByVal new_ファイル名規則 As String)
  If (new_ファイル名規則 Like "*.xls?" Or new_ファイル名規則 Like "*.xls" Or new_ファイル名規則 Like "*.csv") Then
      ファイル名規則_ = new_ファイル名規則
  ElseIf (new_ファイル名規則 Like "【無効】*") Then
      ファイル名規則_ = new_ファイル名規則
  Else
     ファイル名規則_ = "【無効】" & new_ファイル名規則
  End If
  End Property
'「ファイル名規則」というプロパティの取得プロシージャ
Property Get ファイル名規則() As String
  ファイル名規則 = ファイル名規則_
End Property
'「対象シート」というプロパティの設定プロシージャ、対象シートがエクセルもしくはCSV形式でない場合無効
Property Let 対象シート(ByVal new_対象シート As String)
      対象シート_ = new_対象シート
End Property
'「対象シート」というプロパティの取得プロシージャ
Property Get 対象シート() As String
  対象シート = 対象シート_
End Property
'「項目行番号」というプロパティの設定プロシージャ 行番号がないもしくは文字などの場合 1を代入
Property Let 項目行番号(ByVal new_項目行番号 As Long)
  If (new_項目行番号 > 0) Then
      項目行番号_ = new_項目行番号
  Else
      項目行番号_ = 1
  End If
  
End Property
'「項目行番号」というプロパティの取得プロシージャ
Property Get 項目行番号() As Long
  項目行番号 = 項目行番号_
End Property
'「基準列番号」というプロパティの設定プロシージャ 列番号がないもしくは文字などの場合 1を代入
Property Let 基準列番号(ByVal new_基準列番号 As Long)
  If (new_基準列番号 > 0) Then
      基準列番号_ = new_基準列番号
  Else
      基準列番号_ = 1
  End If
End Property
'「基準列番号」というプロパティの取得プロシージャ
Property Get 基準列番号() As Long
  基準列番号 = 基準列番号_
End Property
'「データ数」というプロパティの設定プロシージャ
Property Let データ数(ByVal new_データ数 As Long)
  データ数_ = new_データ数
End Property
'「データ数」というプロパティの取得プロシージャ
Property Get データ数() As Long
  データ数 = データ数_
End Property
'「ファイル数」というプロパティの設定プロシージャ
Property Let ファイル数(ByVal new_ファイル数 As Long)
  ファイル数_ = new_ファイル数
End Property
'「ファイル数」というプロパティの取得プロシージャ
Property Get ファイル数() As Long
  ファイル数 = ファイル数_
End Property
'「フォルダーパス」というプロパティの設定プロシージャ
Property Let フォルダーパス(ByVal new_フォルダーパス As String)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists(new_フォルダーパス) Then
         '指定フォルダーに変更なし
         フォルダーパス_ = new_フォルダーパス
    Else
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = True Then
                 new_フォルダーパス = .SelectedItems(1)
            Else
                 new_フォルダーパス = ""
            End If
        End With
        フォルダーパス_ = new_フォルダーパス
    End If
    Set FSO = Nothing
End Property
'「フォルダーパス」というプロパティの取得プロシージャ
Property Get フォルダーパス() As String
  フォルダーパス = フォルダーパス_
End Property
'「項目数」というプロパティの設定プロシージャ
Property Let 項目数(ByVal new_項目数 As Long)
  項目数_ = new_項目数
End Property
'「項目数」というプロパティの取得プロシージャ
Property Get 項目数() As Long
  項目数 = 項目数_
End Property

フォーム:CSV_OutPut<CSV出力用フォーム>

Private Sub btClose1_Click()
Unload CSV_OutPut
End Sub
Private Sub btCSVOutput_Click()
'エラー時は強制スキップ
On Error GoTo ErrorProcess
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim FileName, Temp_Filename As String
Dim Re As Integer
Dim i, j As Long
    
    With DataListBox1
        For i = 0 To DataListBox1.ListCount - 1
            If DataListBox1.Selected(i) = True Then
                Temp_Filename = DataListBox1.List(i) & "_" & txtDate1.Text & ".csv"
                Sheets(DataListBox1.List(i)).Copy
                FileOutPut = Application.GetSaveAsFilename(InitialFileName:=Temp_Filename, FileFilter:="CSV ファイル (*.csv), *.csv")
                ActiveWorkbook.SaveAs FileName:=FileOutPut, FileFormat:=xlCSV, CreateBackup:=False
                ActiveWorkbook.Close
            End If
        Next i
    End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
ErrorProcess:
MsgBox "出力エラー"
End Sub