CSVファイルを指定最大容量以下に分割

'**********************************
'* ファイル分割メイン処理
'* tbl      : CSVファイルの元の2次元配列（1行目はヘッダー行を想定）
'* fileName : CSVファイルのフルパス
'**********************************
Sub ファイル分割(ByRef tbl As Variant, ByVal fileName As String)

    '--- 定数定義 ---
    Const MAX_FILE_SIZE As Long = 250       ' KB単位の最大ファイルサイズ（ここでは 250KB）
    Const SPLIT_RATIO As Double = 0.96      ' 実際に使用する割合（安全マージン）
    
    ' 実際に使用する閾値（MAX_FILE_SIZE × 割合）
    ' 例：250KB × 0.96 = 240KB を超えないように分割
    Dim EFFECTIVE_SIZE As Double
    EFFECTIVE_SIZE = MAX_FILE_SIZE * SPLIT_RATIO
    
    '--- 元のファイルサイズを取得 ---
    Dim fileSize As Double
    fileSize = FuncFileSize(fileName)   ' KB単位で返却される
    
    ' 容量が指定上限以下なら、そのまま終了（分割不要）
    If fileSize <= MAX_FILE_SIZE Then
        Exit Sub
    End If
    
    '--- 分割数を計算 ---
    ' fileSize ÷ EFFECTIVE_SIZE の結果を切り上げ
    ' → ファイルサイズが閾値を超えるごとに新しい分割を作成
    Dim splitCount As Long
    splitCount = Application.WorksheetFunction.Ceiling(fileSize / EFFECTIVE_SIZE, 1)
    
    '--- CSV分割サブルーチンを呼び出す ---
    Call SplitAndSaveCSV(tbl, fileName, splitCount)
    
    '--- 元ファイル削除処理 ---
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(fileName) Then fso.DeleteFile fileName   ' 元ファイル削除
    Set fso = Nothing
    
End Sub


'**********************************
'* CSV分割処理サブルーチン
'* tbl        : 元の2次元配列（1行目はヘッダー行）
'* fileName   : 元ファイル名（フルパス）
'* splitCount : 分割数
'**********************************
Private Sub SplitAndSaveCSV(ByRef tbl As Variant, ByVal fileName As String, ByVal splitCount As Long)

    '--- 全体の行数を取得 ---
    Dim totalRows As Long
    totalRows = UBound(tbl, 1)   ' tblは1基点の配列を想定
    
    '--- 1分割あたりのデータ行数を算出 ---
    ' （ヘッダー行を除くため -1）
    ' RoundUp を使うことで余りが出た場合も均等に振り分ける
    Dim rowsPerSplit As Long
    rowsPerSplit = Application.WorksheetFunction.RoundUp((totalRows - 1) / splitCount, 0)
    
    Dim i As Long, startRow As Long, endRow As Long
    Dim partArr As Variant
    Dim outFileName As String
    
    '--- 分割ループ ---
    For i = 1 To splitCount
        ' データの開始行と終了行を計算
        startRow = (i - 1) * rowsPerSplit + 2   ' データ開始行（2行目以降）
        endRow = Application.Min(i * rowsPerSplit + 1, totalRows)
        
        '--- 分割配列のサイズを決定 ---
        ' ヘッダー1行 + データ行数
        Dim rowCount As Long
        rowCount = endRow - startRow + 2
        ReDim partArr(1 To rowCount, 1 To UBound(tbl, 2))
        
        '--- ヘッダーコピー ---
        Dim c As Long
        For c = 1 To UBound(tbl, 2)
            partArr(1, c) = tbl(1, c)
        Next c
        
        '--- データコピー ---
        Dim r As Long
        For r = startRow To endRow
            For c = 1 To UBound(tbl, 2)
                partArr(r - startRow + 2, c) = tbl(r, c)
            Next c
        Next r
        
        '--- CSV書き込み ---
        ' 元ファイル名の拡張子前に「-1」「-2」…を付与して保存
        outFileName = Left(fileName, InStrRev(fileName, ".") - 1) & "-" & i & ".csv"
        array_to_csv_Excel partArr, outFileName
    Next i
    
End Sub

'========================================================
' サンプル実行用マクロ
'========================================================
Sub Test_FileSplit()
    Dim tbl As Variant
    Dim fileName As String
    
    ' --- サンプルデータを作成 ---
    ' 1行目: ヘッダー, 2行目以降: データ
    ReDim tbl(1 To 10000, 1 To 3)
    tbl(1, 1) = "ID": tbl(1, 2) = "Name": tbl(1, 3) = "Value"
    Dim i As Long
    For i = 2 To 10000
        tbl(i, 1) = i - 1
        tbl(i, 2) = "Name" & (i - 1)
        tbl(i, 3) = Rnd() * 100
    Next i
    
    ' --- 一旦CSVに保存 ---
    fileName = ThisWorkbook.Path & "\sample.csv"
    array_to_csv_Excel tbl, fileName
    
    ' --- ファイル分割を実行 ---
    Call ファイル分割(tbl, fileName)
    
    MsgBox "処理が完了しました。", vbInformation
End Sub