EXCEL超初心者マクロ（11）
CSVファイル分割（条件あり）

2019年1月31日2019年6月13日

CSVファイルが大量にあり、処理の関係で分割してほしいという要望があり、急遽作成。
ちょっと雑に作ってるので勘弁してください。いつもですけどね。

条件
KANRIシートのB1に取り込むCSVのフォルダを入れてください。

CSVに改行等が入っていいない。
CSVは文字列で取り込む（分割のみが目的な為）

件数と、作成ファイル数を指定出来ます。
簡易版として作ったので、出力の際一件ずつ保存ダイアログで止まります。

SAMPLE13.zip

Dim OUTFILE
Dim rechead
Dim recout
    
    mySheetName001 = "INCSV"
    
   '  ***処理確認***
    MSG_FLG = MsgBox(mySheetName001 & " 分割出力実行OK", vbYesNo)
    If MSG_FLG = vbNo Then
       Exit Sub
    End If
    
' 相手開く

    CNT01 = 1
    
    OUTFILE = Application.GetSaveAsFilename(Worksheets("KANRI").Range("B1") & "\" & _
              mySheetName001 & CStr(Format(Date, "yyyymmdd")) & "_" & CNT01 & ".csv", "カンマ区切り形式 (*.csv), *.csv")
    IntFlNo = FreeFile
    Open OUTFILE For Output As #IntFlNo
   
'### HEAD 作成
    Set set_data01 = Worksheets(mySheetName001).Range("A1")
    rechead = set_data01.Offset(0, 0).value & "," & _
              set_data01.Offset(0, 1).value & "," & _
              set_data01.Offset(0, 2).value & "," & _
              set_data01.Offset(0, 3).value
'##    rechead = "HEAD1,HEAD2,HEAD3,HEAD4"
    
    Print #IntFlNo, rechead
      
    CNT03 = 0

'    Application.StatusBar = "処理実行中．．．．(ＣＳＶ作成中)"
       
    Set set_data01 = Worksheets(mySheetName001).Range("A2")
    
    Do Until set_data01.Offset(0, 0).value = ""
    
'明細処理
    
       recout = set_data01.Offset(0, 0).value & "," & _
                set_data01.Offset(0, 1).value & "," & _
                set_data01.Offset(0, 2).value & "," & _
                set_data01.Offset(0, 3).value
                
       Print #IntFlNo, recout
       CNT03 = CNT03 + 1

       If CNT03 >= MAXDATA.Text Then
          
          CNT01 = CNT01 + 1
          If CNT01 > MAXFILE.Text Then
             Exit Do
          End If
          Close #IntFlNo
          
          CNT03 = 0
          
          OUTFILE = Application.GetSaveAsFilename(Worksheets("KANRI").Range("B1") & "\" & _
                    mySheetName001 & CStr(Format(Date, "yyyymmdd")) & "_" & CNT01 & ".csv", "カンマ区切り形式 (*.csv), *.csv")
          
          IntFlNo = FreeFile
          Open OUTFILE For Output As #IntFlNo
          
         '##    rechead = "HEAD1,HEAD2,HEAD3,HEAD4"
          Print #IntFlNo, rechead
          
       End If

'***次行
       Set set_data01 = set_data01.Offset(1, 0)
    Loop
'===================================================================================
    Close #IntFlNo

    Application.StatusBar = OUTFILE & " 作成終了"

    MsgBox ("処理終了")
'###END