【ExcelVBA】カンマ区切りの文字列を指定範囲に収まるように出力

#■目的
カンマ区切りの文字列を指定範囲に収まるように出力する
・指定範囲に収まる文字数で改行
・改行時はカンマ部分で改行する
・指定範囲に収まらない場合は行を追加する

#■事前準備
・出力用の枠を作っておく
・文字列記載場所、出力用の枠は表示形式を「文字列」にしておく
・マクロ内の定数を必要に応じて変更する

#■サンプルコード

Option Explicit

Sub 文字列成型()

'記載欄は文字列型にしておく

Const brow As Long = 5          '開始行
Const bcol As Long = 2          '開始列
Const MojiNum As Long = 66      '一行に入る文字列
Const TargetRowNum As Long = 5  'テンプレートの行数

Dim targetStr As String         '対象文字列
Dim startNum As Long            '検索開始位置
Dim findNum As Long             '検索結果位置
Dim findStr As String           '検索結果文字列
Dim hanteiStr As String         '文字数確認用
Dim n As Long                   '出力用配列の添え字
Dim targetAry() As String       '出力用配列（1要素に1行分の文字列）
Dim i As Long
Dim j As Long



'対象文字列を変数に格納
targetStr = Range("B2").Value

'出力用配列の添え字を設定（最初は0）
n = 0
ReDim targetAry(0)

'開始位置を設定(最初は1)
startNum = 1

'対象文字列の「,」の位置を検索し、検索結果が0になるまで繰り返し
Do Until InStr(startNum, targetStr, ",") = 0

'検索結果位置を変数に格納
findNum = InStr(startNum, targetStr, ",")

'（最初は1,2回目以降は開始位置+1）から（検索結果位置-1）を抜き出す（検索結果文字列）
If startNum = 1 Then
    findStr = Mid(targetStr, 1, findNum - 1)
Else
    findStr = Mid(targetStr, startNum, findNum - startNum)
End If

'検索結果文字列を文字数確認用変数に格納（「,」を追記）
If hanteiStr = "" Then
    hanteiStr = findStr & ","
Else
    hanteiStr = hanteiStr & findStr & ","
End If

'文字数確認用配列の文字数を調べる
'66以下の場合
If Len(hanteiStr) <= MojiNum Then
    '文字数確認用配列の値を出力用配列へ
    targetAry(n) = hanteiStr

'66以上の場合
 Else
    '出力用配列の添え字を+1して検索結果文字列を格納
    n = n + 1
    ReDim Preserve targetAry(n)
    targetAry(n) = findStr & ","
    
    '文字列確認用変数の値を更新
    hanteiStr = findStr & ","

End If

'開始位置を設定
startNum = findNum + 1

Loop


'残りの値がある場合
If Len(targetStr) > startNum Then
    '残りの値を出力用配列に格納
    
    '出力用配列最終添え字に値が入る場合は追記
    If targetAry(n) <> "" And Len(targetAry(n)) < MojiNum Then
        targetAry(n) = targetAry(n) & Right(targetStr, Len(targetStr) - startNum + 1)
    
    '入らない場合は新しい添え字を+1して格納
    Else
        n = n + 1
        ReDim Preserve targetAry(n)
        targetAry(n) = Right(targetStr, Len(targetStr) - startNum + 1)
    
    End If

End If


'出力用配列の添え字数が行数以上の場合
If UBound(targetAry) + 2 > TargetRowNum Then

    '必要な数だけ行を増やす
    Rows(brow + 1 & ":" & brow + UBound(targetAry) + 2 - TargetRowNum).Insert
    
End If


'出力用配列の値を転記
For j = 0 To UBound(targetAry)
    Cells(brow + j, bcol).Value = targetAry(j)
    
Next j


End Sub

#■サンプルコードの解説

・Excelの内容