Excelマクロで指定文字数（31文字）でその文字数の一番後ろの指定文字で改行するExcelマクロの記述方法について

Excelのマクロを使って指定文字数（31文字）で
その文字数の一番後ろの指定文字で改行するマクロの記述方法を探しています

Excelのマクロで指定文字数（31文字）でA1列にある文字列を

その文字数の一番後ろの指定文字で
改行し、B1列に張り付けるマクロの記述方法が分からず困っています

具体的には、一行が31文字で

31文字内に「、」「。」「？」「（笑）」「・・・・」

「★ 」「！」「！？」「」」などの文字があった場合、

31文字以内の一番後ろの指定文字で

改行するマクロが作りたいです

下記の文章を読みやすく見栄えの良い文章に改行し1行空けたいです。

31文字以内に指定文字がない場合は31文字で改行するようにし、

処理した結果をB1列に張り付けたいです

A1列にある文字列

例；今日は、朝から天気が良く、真夏日になるらしいので、熱中症対策には十分気を付けたいです。（笑）庭にブールーベリーやひまわりが植えているので暑くなる前に水やりをしたいと思ます★ブルーベリーの実がなってきて色づいてきたのでもう少ししたら収穫できるのではないかと今から楽しみでなりません！？朝から水やりをした後に近所でラジオ体操をやっているので、姪っ子と甥っ子を連れて、ラジオ体操に今から行ってきます。「眠い」と思わず声にでてしまう時も多々ありますが、さぼらないように頑張りたいと思います。

↓↓Excelのマクロでしたい処理結果（処理結果をB1に張り付ける）

今日は、朝から天気が良く、真夏日になるらしいので、

熱中症対策には十分気を付けたいです。（笑）

庭にブールーベリーやひまわりが植えているので暑くなる前に水やり

をしたいと思ます★

ブルーベリーの実がなってきて色づいてきたのでもう少ししたら収穫

できるのではないかと今から楽しみでなりません！？

朝から水やりをした後に近所でラジオ体操をやっているので、

姪っ子と甥っ子を連れて、ラジオ体操に今から行ってきます。

「眠い」と思わず声にでてしまう時も多々ありますが、

さぼらないように頑張りたいと思います。

秀丸のマクロでは以下の記述で出来たのですが

excelのマクロでどのように記述するのか分からず困っています

ご教授よろしくお願いいたします


setcompatiblemode 0x2000f;

// 改行する桁数の定義
#lf_column = 70;

// 改行する指定文字列の定義
$lf_str[0] ="、";
$lf_str[1] ="。";
$lf_str[2] ="？";
$lf_str[3] ="！";
$lf_str[4] ="★";
$lf_str[5] ="」";
$lf_str[6] ="（笑）";
$lf_str[7] ="・・・+"; // 中黒が3つ以上連続
#lf_str_num = 8;

// 検索用文字列の作成
$search_str = $lf_str[0];
#i = 1;
while( #i < #lf_str_num ) {
$search_str = $search_str + "|" + $lf_str[#i];
#i = #i + 1;
}

begingroupundo;
disabledraw;
replaceallfast "\n", ""; // 改行文字を一旦全削除する
gofiletop;

// 改行挿入ループ
while( 1 ) {
beginsel;
moveto2 #lf_column, lineno;
if( code == eof ) break; // ファイルの最後なら終了
searchup2 "(?\\2)(" + $search_str + ")((?!" + $search_str + "))", regular, inselect; // ※1
insert "\n\n";
}

escape; // 選択範囲を解除
insert "\n"; // 最下行の処理
gofiletop;
endgroupundo;
endmacro;

行動規範の内容に同意します

回答5件

ベストアンサー

【再回答】
お詫び

先だって回答した内容に仕様の見落としがあったため、改めて回答させていただきましたm(__)m

処理手順

①対象文字列を取得する

（ループ１開始 ～対象文字列がなくなるまでループ処理～）
 　②対象文字列から先頭３１文字分を切り出す

　　（ループ２開始 ～区切り文字の数だけループ処理～）
 　　　③切り出した文字列から区切り文字を検索する
 
　　　 ④区切り文字が含まれていた場合、最後の区切り文字までの文字長を取得
  　　　※全ての区切り文字で最長となる文字数を調べる
　　（ループ２ここまで）
 
　 ⑤対象文字列（３１文字）から最大の文字長となる区切り位置までの文字列を切り出す
　  ※区切り文字がひとつも見つからなかった場合、対象文字（３１文字）をそのまま使用とする

　 ⑥⑤で切り出した文字列に改行をつけて出力用文字列に連結する

　 ⑦出力した文字数分、対象文字列の先頭を削る
  　⇒これが次回の対象文字列となります。

　 ⑧対象文字列がなくなったらループ１終了
（ループ１ここまで）

⑨出力用文字列が変換結果として完成

以下、サンプルソースです。

ソース①：メインロジック（関数名は任意でOK）

Sub Test2()
    Dim sht As Worksheet
    Set sht = Sheets("Sheet5")    'シート名は任意に指定
    'Set sht = ActiveSheet        'アクティブシートでマクロ実行する場合はこちらでも可

    Dim aryPtn As Variant
    Dim ptn As Variant
    aryPtn = Array("、", "。", "★", "」", "｣", "）", "\)", "\!", "\?", "！", "？", "・+")
    
    Dim strOutput As String '結果出力用
    
    Dim strLine As String   '１行に出力する文字列
    Dim strRest As String   '未処理の文字列
    
    'セル(A1)から文字列を取得
    strRest = sht.Range("A1").Value
    
    Dim iLen As Integer
    iLen = -1

    'ループ処理
    Do
        '先頭31文字を切り出す
        strLine = Left(strRest, 31)
        
        '文字長の初期化
        iLen = -1

        '置換パターンの数だけループ処理
        For Each ptn In aryPtn
            '最後にマッチした区切り文字までの文字長を調べる
            Dim iLenWk As Integer
            iLenWk = FindEx(strLine, ptn)
            If iLenWk > iLen Then
                '長い文字長を採用していく
                iLen = iLenWk
            End If
        Next
        
        If iLen > 0 Then
            '区切り文字が見つかった場合、文字列を切り出す
            strLine = Left(strLine, iLen)
        End If
        
        '切り出した文字列を出力
        strOutput = strOutput & strLine 
        
        '切り出した文字列分を未出力文字列から除去
        strRest = Mid(strRest, Len(strLine) + 1)
        
        If strRest = "" Then
            '未出力文字列がなくなったら終了
            Exit Do
        End If

        '次の行を作る前に改行を追記
        strOutput = strOutput & vbLf & vbLf
    Loop
    
    ''結果をB1セルに出力
    'sht.Range("B1") = strOutput

    '結果をクリップボードに出力
    Dim objClip As New DataObject
    With objClip
        .SetText strOutput  'クリップボードにセットする値を指定
        .PutInClipboard     'クリップボードに格納
    End With    

End Sub

ソース②：正規表現検索FindEx(メインロジックで使用している為ファンクション名は変更不可)

'正規表現検索（最終マッチ文字までの文字長を返す）
Function FindEx(ByVal vsTarget As String, ByVal vsPattern As String) As Integer

    Dim iIdx As Integer
    Dim objReg As Object
    Dim objMatchs
    
    Set objReg = CreateObject("VBScript.RegExp")
    
    With objReg
        .Pattern = vsPattern
        .IgnoreCase = True
        .Global = True
        '正規表現検索
        Set objMatchs = .Execute(vsTarget)
        If objMatchs.Count = 0 Then
            'マッチしなかった場合-1
            FindEx = -1
        Else
            'マッチ数を取得
            iIdx = objMatchs.Count - 1
            'マッチした候補の最終文字列までの文字長を返す
            FindEx = objMatchs(iIdx).FirstIndex + objMatchs(iIdx).Length
        End If
        
    End With
    
    Set objReg = Nothing
    
End Function

参考になれば幸いです。

変換結果

今日は、朝から天気が良く、真夏日になるらしいので、

熱中症対策には十分気を付けたいです。（笑）

庭にブールーベリーやひまわりが植えているので暑くなる前に水やり

をしたいと思ます★

ブルーベリーの実がなってきて色づいてきたのでもう少ししたら収穫

できるのではないかと今から楽しみでなりません！？

朝から水やりをした後に近所でラジオ体操をやっているので、

姪っ子と甥っ子を連れて、ラジオ体操に今から行ってきます。

「眠い」と思わず声にでてしまう時も多々ありますが、

さぼらないように頑張りたいと思います。

投稿2016/11/22 12:01

編集2016/11/25 07:11

jawa

総合スコア3020

退会済みユーザー

2016/11/22 12:48

to jawa様こちらでも試しに実行してみたところ、変数「ptn」が定義されていなかった事以外はおそらくこの方法が一番だと思います。 ryuujinn様本マクロは私も実験してみたところ、おそらくは理想的な結果ではないかと思います。

質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう！

【再回答】 お詫び

処理手順

変換結果

サンプルコード

関連した質問

【再回答】
お詫び