■목적

■ 사전 준비

■ 샘플 코드

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

■ 샘플 코드 해설