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;
気になる質問をクリップする
クリップした質問は、後からいつでもMYページで確認できます。
またクリップした質問に回答があった際、通知やメールを受け取ることができます。
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。

回答5件
0
ベストアンサー
【再回答】
お詫び
先だって回答した内容に仕様の見落としがあったため、改めて回答させていただきましたm(__)m
処理手順
①対象文字列を取得する (ループ1開始 ~対象文字列がなくなるまでループ処理~) ②対象文字列から先頭31文字分を切り出す (ループ2開始 ~区切り文字の数だけループ処理~) ③切り出した文字列から区切り文字を検索する ④区切り文字が含まれていた場合、最後の区切り文字までの文字長を取得 ※全ての区切り文字で最長となる文字数を調べる (ループ2ここまで) ⑤対象文字列(31文字)から最大の文字長となる区切り位置までの文字列を切り出す ※区切り文字がひとつも見つからなかった場合、対象文字(31文字)をそのまま使用とする ⑥⑤で切り出した文字列に改行をつけて出力用文字列に連結する ⑦出力した文字数分、対象文字列の先頭を削る ⇒これが次回の対象文字列となります。 ⑧対象文字列がなくなったらループ1終了 (ループ1ここまで) ⑨出力用文字列が変換結果として完成
以下、サンプルソースです。
ソース①:メインロジック(関数名は任意で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 '1行に出力する文字列 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総合スコア3020
0
記載いただいている条件を全て区切ると、結果は期待されている内容にはなりません。
例えば"、"のたびに改行されますし、「!?」も「!」で改行、「?」でまた改行されるはずです。
※区切り文字が連続して出現した場合はひと塊として扱うというルール(仕様)でもあれば、もう少し期待する結果となるかもしれません。
前提仕様には問題がありそうですが、「目的の文字を見つけて改行する」という処理の手順としては以下のような流れで実現できると思います。
処理手順
①対象文字列を取得する
②対象文字列から先頭31文字分を切り出す
③切り出した文字列に区切り文字が含まれていたら、区切り文字の後にタブ文字を挿入する
④③で編集した文字列をタブ文字で分割する
⑤④の分割結果文字列に改行をつけて出力用文字列に連結する
⑥出力した文字数分、対象文字列の先頭を削る
⇒これが次回の対象文字列となります。
⑦対象文字列がなくなるまで②~⑥を繰り返す
補足1:
③でタブ文字を挿入しているのは、④で使用しているSplit関数で複数文字を指定した分割ができないため、事前準備をしています。
区切り文字の後ろにタブ文字(通常ではセル内に入力されない文字)を挿入し、Split関数でこのタブ文字を見つけて分割する、という流れになります。
補足2:
④のSplit関数でタブ文字が含まれていた場合、タブ文字ごとに分割した文字列配列を返します。
配列の先頭の文字列が、区切れ目の文字列となります。
もしタブ文字が見つからなかった場合、Split関数は全体の文字列(31文字)をそのまま返します。
サンプルコード
以下、上記の手順で作成したサンプルです。
区切り文字の条件に、複数個連続する「・」で改行というものがあったため、区切り文字の検索には正規表現検索を採用しています。
Sub Test() Dim aryPtn As Variant '区切り文字 aryPtn = Array("。", ")", "★", "\)", "\!", "!?", "\!\?", "・+") Dim strOutput As String '結果出力用 Dim strLine As String '1行に出力する文字列 Dim strRest As String '未処理の文字列 'セル(A1)から文字列を取得 strRest = Sheet5.Range("A1").Value 'ループ処理 Do '31文字分を抽出 strLine = Left(strRest, 31) '置換パターンの数だけループ処理 Dim strTemp As String '置換結果文字列 strTemp = strLine For Each ptn In aryPtn '区切り文字の後ろにタブ文字を挿入する(正規表現置換)※ptn文字列 ⇒ ptn文字列+タブ文字に置換 strTemp = ReplaceEx(strTemp, "(" & ptn & ")", "$1" & vbTab) Next '最初の区切りまでの文字列を取得する strLine = Split(strTemp, vbTab)(0) '切り出した文字列に改行をつけて出力 strOutput = strOutput & strLine & vbCrLf '切り出した文字列分を未出力文字列から除去 strRest = Mid(strRest, Len(strLine) + 1) If strRest = "" Then '未出力文字列がなくなったら終了 Exit Do End If Loop '結果をメッセージ表示 MsgBox strOutput End Sub '正規表現置換 Function ReplaceEx(vsTarget As String, vsPattern As String, vsReplace As String ) As String Dim objReg As Object Dim strRet As String Set objReg = CreateObject("VBScript.RegExp") With objReg .Pattern = vsPattern .IgnoreCase = True .Global = True '正規表現置換 strRet = .Replace(vsTarget, vsReplace) End With ReplaceEx = strRet Set objReg = Nothing End Function
参考になれば幸いです。
投稿2016/11/22 10:15
総合スコア3020
0
VBAで作ってみました。
突貫なので全然きれいなソースではないのですが、参考になれば幸いです。
ボタンを適当に作って、ボタン押下後の処理となっております。
※2016/11/24 修正
VBA
1' 改行する指定文字列の定義(増やしたい時は最後尾に「,追加文字列」とする) 2Private Const strSplit As String = "、,。,?,?,!,!,★,」,(笑),・・・" 3 4'上記改行する文字列以外で使いそうもない記号・文字 5Private Const strReplace As String = "□" 6 7'ボタン押下処理 8Private Sub CommandButton1_Click() 9 Dim strA1 As String ' A1の文字列を格納 10 Dim valNewLine As Variant ' 改行指定文字列を格納 11 Dim valSplitA1 As Variant ' A1の文字列を区切ったものを格納 12 Dim strMainSent As String ' A1文字列を色々弄っては格納する文字列 13 Dim strTempSent As String ' strLastSentに入れる前の仮 14 Dim strLastSent() As String ' 最終的に出力するものを格納 15 16 Dim intNum As Integer ' 繰り返した回数 17 Dim blnFlag As Boolean ' フラグ(true:繰り返す、false:条件満たして終了) 18 Dim i As Integer ' For文で使用 19 20 'B列クリア 21 Columns("B").Clear 22 23 'A1の長文を格納 24 If Cells(1, 1).Value = "" Then 25 MsgBox ("A1セルに文字がありません。") 26 Exit Sub 27 End If 28 strA1 = Cells(1, 1).Value 29 30 '改行する指定文字列 31 valNewLine = Split(strSplit, ",") 32 33 '指定文字列文繰り返す 34 strMainSent = strA1 35 For Each nl In valNewLine 36 strMainSent = Replace(strMainSent, nl, nl & strReplace) 37 Next nl 38 39 '--------------------------------------- 40 ' ここまでで、指定文字列の後ろにすべて 41 ' 使いそうもない記号・文字が加わっている 42 '--------------------------------------- 43 44 'A1の文字列を区切る 45 valSplitA1 = Split(strMainSent, strReplace) 46 47 '色々初期化 48 ReDim strLastSent(0) 49 blnFlag = True 50 intNum = 0 51 strTempSent = "" 52 53 'A1の文字列を整える 54 Do While blnFlag 55 If intNum <> 0 Then 56 57 '----------------------------------------- 58 ' 文字列の数が問題ないか確認(文字数) 59 ' 文字数ならLen、バイトで見るならLenBを使用 60 ' 今回は文字数で実施してます 61 '----------------------------------------- 62 63 '単体で32文字より大きかった時の処理 64 If Len(strTempSent) > 31 Then 65 ReDim Preserve strLastSent(UBound(strLastSent) + 1) 66 strLastSent(UBound(strLastSent)) = Left(strTempSent, 31) 67 strTempSent = Mid(strTempSent, 32) 68 End If 69 70 '組み合わせで32文字未満かどうかの処理 71 If Len(strTempSent + valSplitA1(intNum)) < 32 Then 72 strTempSent = strTempSent + valSplitA1(intNum) 73 Else 74 '格納配列を増やして最後尾に格納 75 ReDim Preserve strLastSent(UBound(strLastSent) + 1) 76 strLastSent(UBound(strLastSent)) = strTempSent 77 strTempSent = valSplitA1(intNum) 78 End If 79 80 Else 81 '初回のみ 82 strTempSent = valSplitA1(0) 83 End If 84 85 '最終配列か確認 86 If intNum = UBound(valSplitA1) Then 87 blnFlag = False 88 89 '最後の文字列を格納 90 ReDim Preserve strLastSent(UBound(strLastSent) + 1) 91 strLastSent(UBound(strLastSent)) = strTempSent 92 End If 93 94 intNum = intNum + 1 95 Loop 96 97 '出力処理① -- 以下、変更箇所 98 For i = 1 To UBound(strLastSent) 99 Cells(1, 2).Value = Cells(1, 2).Value & strLastSent(i) & vbLf & vbLf 100 Next i 101 102 '--------------------------------------------------------- 103 ' もし最終行「さぼらないように頑張りたいと思います。」の後に 104 ' 改行を入れたくなければ以下4行の先頭「'」を外して 105 ' 上記出力処理①のFor~Nextの3行の先頭に「'」をつけてください 106 '---------------------------------------------------------- 107 '出力処理② 108' For i = 1 To UBound(strLastSent) - 1 109' Cells(1, 2).Value = Cells(1, 2).Value & strLastSent(i) & vbLf & vbLf 110' Next i 111' Cells(1, 2).Value = Cells(1, 2).Value & strLastSent(UBound(strLastSent)) 112 113End Sub 114
出力結果は以下の通りです。
-------- 出力結果 ここから -------------
今日は、朝から天気が良く、真夏日になるらしいので、
熱中症対策には十分気を付けたいです。(笑)
庭にブールーベリーやひまわりが植えているので暑くなる前に水やり
をしたいと思ます★
ブルーベリーの実がなってきて色づいてきたのでもう少ししたら収穫
できるのではないかと今から楽しみでなりません!?
朝から水やりをした後に近所でラジオ体操をやっているので、
姪っ子と甥っ子を連れて、ラジオ体操に今から行ってきます。
「眠い」と思わず声にでてしまう時も多々ありますが、
さぼらないように頑張りたいと思います。
-------- 出力結果 ここまで -------------
長々となってしまいましたが、要は指定文字列の後ろに指定文字列以外の使いそうもない記号(今回のソースだと□)を置いて、そこから31字以上かどうか判断していく、という方法で作成しました。
参考になれば幸いです。
### 追記1
ご希望の処理にそっておらず申し訳ございません。
出力処理箇所を修正いたしましたので、お試し頂ければと思います。
出力箇所①、②は最終行の出力に合わせてどちらかを選んで頂ければと思います。
以上、参考になれば幸いです。
### 追記2
EXCELのB1セルをコピペして秀丸などに張り付けた時に先頭と最後尾に「"」が入ってしまう現象を確認いたしました。
おそらく、こちらのサイトが参考になるかと思いますエクセル術
こちらのサイトで色々手法が乗っておりますが、その中の「エクセルのコピー時にダイレクトにクリップボード操作するマクロ」が良いのではないかと思いました。
上記の方法を現状に合わせるならば、今までのソースをボタン1とするならば、ボタン2を作って以下のソースをボタン2の処理とします。
VBA
1'ボタン2の処理 2Private Sub CommandButton2_Click() 3 Dim buf As String, buf2 As String, CB As New DataObject 4 buf = ActiveCell 5 With CB 6 .SetText buf ''変数のデータをDataObjectに格納する 7 .PutInClipboard ''DataObjectのデータをクリップボードに格納する 8 .GetFromClipboard ''クリップボードからDataObjectにデータを取得する 9 buf2 = .GetText ''DataObjectのデータを変数に取得する 10 End With 11End Sub 12
(ツールの参照設定にある Microsoft Forms 2.0 Object Library を使えるようにする必要あり。私の環境では最初から使えるようになっていたのでもしかしたら設定不要かもしれません)
これを作成したのち、
① ボタン1押下(これで「今日は、朝から天気が良く、~」の文章が改行してB1に作られる)
② B1セルを選択
③ ボタン2押下
④ 秀丸などに張り付ける
という方法でご希望の方法が達成されるかと思います。
(③実行しても特にアクションとかありませんが、④の貼り付けができます)
ボタン2作るのが面倒な場合は、セルをコピーするのではなく、中を選択(B1セルでF2を選択)してからすべてコピペしたのちに秀丸に張り付ければこの現象は回避できます。
以上、参考になれば幸いです。
### 追記3
回答および追記2のソースを一つのボタンで実行できるようにまとめてみました。
(言われずともボタン1つで完了させるべきでした。横着してしまいすみません)
VBA
1' 改行する指定文字列の定義(増やしたい時は最後尾に「,追加文字列」とする) 2Private Const strSplit As String = "、,。,?,?,!,!,★,」,(笑),・・・" 3 4'上記改行する文字列以外で使いそうもない記号・文字 5Private Const strReplace As String = "□" 6 7'ボタン押下処理 8Private Sub CommandButton1_Click() 9 Dim strA1 As String ' A1の文字列を格納 10 Dim valNewLine As Variant ' 改行指定文字列を格納 11 Dim valSplitA1 As Variant ' A1の文字列を区切ったものを格納 12 Dim strMainSent As String ' A1文字列を色々弄っては格納する文字列 13 Dim strTempSent As String ' strLastSentに入れる前の仮 14 Dim strLastSent() As String ' 最終的に出力するものを格納 15 16 Dim intNum As Integer ' 繰り返した回数 17 Dim blnFlag As Boolean ' フラグ(true:繰り返す、false:条件満たして終了) 18 Dim i As Integer ' For文で使用 19 20 '修正:B列 → B1セルクリア 21 'Columns("B").Clear 22 Range("B1").Clear 23 24 'A1の長文を格納 25 If Cells(1, 1).Value = "" Then 26 MsgBox ("A1セルに文字がありません。") 27 Exit Sub 28 End If 29 strA1 = Cells(1, 1).Value 30 31 '改行する指定文字列 32 valNewLine = Split(strSplit, ",") 33 34 '指定文字列文繰り返す 35 strMainSent = strA1 36 For Each nl In valNewLine 37 strMainSent = Replace(strMainSent, nl, nl & strReplace) 38 Next nl 39 40 '--------------------------------------- 41 ' ここまでで、指定文字列の後ろにすべて 42 ' 使いそうもない記号・文字が加わっている 43 '--------------------------------------- 44 45 'A1の文字列を区切る 46 valSplitA1 = Split(strMainSent, strReplace) 47 48 '色々初期化 49 ReDim strLastSent(0) 50 blnFlag = True 51 intNum = 0 52 strTempSent = "" 53 54 'A1の文字列を整える 55 Do While blnFlag 56 If intNum <> 0 Then 57 58 '----------------------------------------- 59 ' 文字列の数が問題ないか確認(文字数) 60 ' 文字数ならLen、バイトで見るならLenBを使用 61 ' 今回は文字数で実施してます 62 '----------------------------------------- 63 64 '単体で32文字より大きかった時の処理 65 If Len(strTempSent) > 31 Then 66 ReDim Preserve strLastSent(UBound(strLastSent) + 1) 67 strLastSent(UBound(strLastSent)) = Left(strTempSent, 31) 68 strTempSent = Mid(strTempSent, 32) 69 End If 70 71 '組み合わせで32文字未満かどうかの処理 72 If Len(strTempSent + valSplitA1(intNum)) < 32 Then 73 strTempSent = strTempSent + valSplitA1(intNum) 74 Else 75 '格納配列を増やして最後尾に格納 76 ReDim Preserve strLastSent(UBound(strLastSent) + 1) 77 strLastSent(UBound(strLastSent)) = strTempSent 78 strTempSent = valSplitA1(intNum) 79 End If 80 81 Else 82 '初回のみ 83 strTempSent = valSplitA1(0) 84 End If 85 86 '最終配列か確認 87 If intNum = UBound(valSplitA1) Then 88 blnFlag = False 89 90 '最後の文字列を格納 91 ReDim Preserve strLastSent(UBound(strLastSent) + 1) 92 strLastSent(UBound(strLastSent)) = strTempSent 93 End If 94 95 intNum = intNum + 1 96 Loop 97 98 '出力処理① 99 For i = 1 To UBound(strLastSent) 100 Cells(1, 2).Value = Cells(1, 2).Value & strLastSent(i) & vbLf & vbLf 101 Next i 102 103 '--------------------------------------------------------- 104 ' もし最終行「さぼらないように頑張りたいと思います。」の後に 105 ' 改行を入れたくなければ以下4行の先頭「'」を外して 106 ' 上記出力処理①のFor~Nextの3行の先頭に「'」をつけてください 107 '---------------------------------------------------------- 108 '出力処理② 109' For i = 1 To UBound(strLastSent) - 1 110' Cells(1, 2).Value = Cells(1, 2).Value & strLastSent(i) & vbLf & vbLf 111' Next i 112' Cells(1, 2).Value = Cells(1, 2).Value & strLastSent(UBound(strLastSent)) 113 114 '-- ここから追加 -- 115 116 'B1セルにカーソルをあてる 117 Cells(1, 2).Select 118 119 'コード2 120 Dim buf As String, buf2 As String, CB As New DataObject 121 buf = ActiveCell 122 With CB 123 .SetText buf ''変数のデータをDataObjectに格納する 124 .PutInClipboard ''DataObjectのデータをクリップボードに格納する 125 .GetFromClipboard ''クリップボードからDataObjectにデータを取得する 126 buf2 = .GetText ''DataObjectのデータを変数に取得する 127 End With 128End Sub
変更箇所としては、B1セルにカーソルを移動させてからクリップボードにコピーをするようにしました。
処理完了時点でクリップボードにコピーされておりますので、処理完了後に秀丸を開いて張り付ければご希望の処理になっているかと思います。ご確認くださいませ。
ボタン操作の中にほぼソースを入れてしまったのでまったくもって綺麗とはかけ離れたソースになってしまいました・・・。お好みでプロシージャ分けなどして頂ければと思います。
参考になれば幸いです。
投稿2016/11/22 02:18
編集2016/11/25 07:07総合スコア247
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。

0
3年ぶりにVBA触ったので手こずりましたが、
以下でどうでしょうか。
VBA
1Option Explicit 2 3Sub Kaigyou() 4 Const targetCell = "A1" 5 Const ResultCell = "B1" 6 Dim text As String 7 Dim targetArr As Variant 8 targetArr = Array("、", "。", "?", "!", "★", "」", "(笑)", "・・・") 9 10 Application.ScreenUpdating = False 11 12 text = ActiveSheet.Range(targetCell).Value 13 14 Dim tmp As Variant 15 16 For Each tmp In targetArr 17 text = Replace(text, tmp, tmp & vbCrLf) 18 Next 19 20 ActiveSheet.Range(ResultCell).Value = text 21 22 Application.ScreenUpdating = True 23End Sub 24
出力結果は理想通りではないかもですが、
指定文字で改行すると以下になります。
"今日は、
朝から天気が良く、
真夏日になるらしいので、
熱中症対策には十分気を付けたいです。
(笑)
庭にブールーベリーやひまわりが植えているので暑くなる前に水やりをしたいと思ます★
ブルーベリーの実がなってきて色づいてきたのでもう少ししたら収穫できるのではないかと今から楽しみでなりません!
?
朝から水やりをした後に近所でラジオ体操をやっているので、
姪っ子と甥っ子を連れて、
ラジオ体操に今から行ってきます。
「眠い」
と思わず声にでてしまう時も多々あり"
投稿2016/11/21 12:58
編集2016/11/21 13:02総合スコア882
0
横入り失礼します。
取り敢えず、31文字ごとにvbLfを入れてセルに代入するコードは何とかできましたが、
特定文字で折り返すとなると、他の方々のコードをご参考頂くか、下記コードの正規表現パターンを
変更する方法もありかと(正規表現については私もあまり詳しくないので、申し訳ございません…)。
Excel
1 2Sub Enter_sample1() 3'このマクロでは、31文字ごとにvbLrを2回入れて、セルA1の文字列をセルA2に代入可能。 4'前提条件として、「ツール→参照設定」で、「MicroSoft VBScript Regular Expressons 5.5」 5'にチェックを入れること。 6 7Dim i As Long 'ループ変数 8Dim inputStr As String '処理前文字列 9Static outputStr As String '処理後文字列 10 11Dim Rexp As RegExp '正規表現を使用可能とするオブジェクト 12Dim strPtn As String '正規表現パターン(VBScript準拠) 13Dim mc As MatchCollection 'パターンマッチしたものの集合 14Dim chgstr() As String 'マッチした文字列にvbLfを結合したものを格納する変数 15 16 17Set Rexp = New RegExp 18outputStr = "" '処理後文字列の初期化(Static変数なので、変数内容をクリアにする必要がある) 19 20 21strPtn = ".{1,31}" '任意の1文字以上31文字以下の文字列を抽出する正規表現 22inputStr = Cells(1, 1).Value '入力文字列 23 24'正規表現に基づいた文字列処理 25With Rexp 26 27 .Pattern = strPtn '適用する正規表現パターン 28 .Global = True '文字列全体を正規表現対象とする 29 30 Set mc = .Execute(inputStr) '正規表現検索をする命令 31 32End With 33 34 ReDim chgstr(mc.Count - 1) 35 36 37 '正規表現で抽出した文字列に、vbLfを2回追加する(セル内の折り返しはLF) 38 39 For i = 0 To mc.Count - 1 40 41 chgstr(i) = mc.Item(i) & vbLf & vbLf 42 43 Next i 44 45 '出力文字列を作成 46 47 For i = 0 To UBound(chgstr) 48 49 outputStr = outputStr & chgstr(i) 50 51 Next i 52 53 'セルA2に文字列を代入する(B1の場合はCells(1,2)とする) 54 'A2としたのは処理結果を確認できるようにしたため 55 56 Cells(2, 1).Value = outputStr 57 58'終了処理(全てのオブジェクトを開放、Static変数を空にする) 59 60Set Rexp = Nothing 61Set mc = Nothing 62outputStr = "" 63 64End Sub 65
もし正規表現に詳しい方おられましたら、ご意見等お願い致します。
(私ももう少しやってみようと思います。面白い試みだと思いましたので。)
参考(翔泳社会員登録が必要)VBAで正規表現を使う
追記:
ryuujinn様
ふと思いましたが、コードを追加する場合、「1つのSub内にすべて入れ込まないといけない」と
思っておりませんか?
その場合、コードが非常に縦方向に長くなり、訳が分からない状態になってしまう恐れが
ございます。
Excel-VBAは「『オブジェクト指向プログラミング』が可能な言語=複数のプロシージャを「部品のように」組み合わせるプログラムが作成可能な言語」ですので、以下のように組む方法をお勧めします。
Excel
1 2Sub Sample1() 3 処理1 4END Sub 5 6Sub Sample2() 7 処理2 8End Sub
と作成し、「Sample1→Sample2」のように実行したいときは、
Excel
1Sub Sample3() 2 '呼び出すプロシージャ名の()は不要 3 Call Sample1 4 Call Sample2 5 6End Sub
と、「Call」を使ってプロシージャを追加すると、プロシージャの改良や追加が楽になり、
エラーも起きにくくなりますよ?
(FunctionはCallを使わないこと。)
あるいは、このようにしても大丈夫です。
Excel
1Sub Sample1() 2 処理1 3 4 Call Sample2 5 6END Sub
老婆心ながら、という事で。
あと、「最後の行だけ改行を入れない」というのであれば、
- jawa様の「メイン2」の変数「strOutput」を「動的配列」にする。
- 配列の最大インデックス番号に格納されたデータのみvbCrlfを入れないように条件を分ける
このように言われても「??」だとは思いますが…。
もし分からない場合は、コメント等でお尋ねください。
頑張って!
投稿2016/11/22 11:31
編集2016/11/25 04:46
退会済みユーザー
総合スコア0
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。

退会済みユーザー
2016/11/23 05:32

あなたの回答
tips
太字
斜体
打ち消し線
見出し
引用テキストの挿入
コードの挿入
リンクの挿入
リストの挿入
番号リストの挿入
表の挿入
水平線の挿入
プレビュー
質問の解決につながる回答をしましょう。 サンプルコードなど、より具体的な説明があると質問者の理解の助けになります。 また、読む側のことを考えた、分かりやすい文章を心がけましょう。
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
退会済みユーザー
2016/11/22 12:48
2016/11/23 04:27
2016/11/23 04:28
2016/11/23 04:57
退会済みユーザー
2016/11/23 05:25
2016/11/24 01:06
2016/11/24 04:50
2016/11/24 05:37 編集
2016/11/24 08:09
2016/11/25 00:34 編集
2016/11/25 03:21
2016/11/25 04:28 編集
2016/11/25 06:13
2016/11/25 07:05
2016/11/26 12:03
2016/11/28 02:18 編集
退会済みユーザー
2016/11/28 02:45
2016/11/28 07:28
2016/11/30 00:47
2016/11/30 03:03
2016/12/02 04:58