エクセルのマクロで改行挿入(Excel2002)

質問

セルの文字列に全角10文字(半角20文字)ごとに Chr(10) で改行を入れたいです。
全角10文字を越えてはダメ。
選択したセルに動作する物です。
- - - - -
Sub 半角20改行_Click()
Dim Tmp As Range, Cha As Long, Num As Long
Dim STR As String, MdTmp As Variant, flg As Boolean
For Each Tmp In Selection
　For Cha = 1 To Len(Tmp.Value)
　　MdTmp = Mid(Tmp.Value, Cha, 1)
　　If MdTmp = vbLf Then
　　　If flg = False Then STR = STR & MdTmp
　　　Num = 0
　　　GoTo NextRow
　　End If
　　If LenB(StrConv(MdTmp, 128)) = 1 Then
　　　Num = Num + 1
　　Else
　　　Num = Num + 2
　　End If
　　' この↓(20)で改行文字数変更
　　If Num >= 20 - 1 Then
　　　STR = STR & MdTmp & vbLf
　　　flg = True
　　　Num = 0
　　Else
　　　STR = STR & MdTmp
　　　flg = False
　　End If
NextRow:
　Next
　Tmp.Value = STR
　STR = ""
　Num = 0
Next
For Each Tmp In Selection
　If Right(Tmp, 1) = Chr(10) Then
　　Tmp.Value = LeftB(Tmp, LenB(Tmp) - 2)
　End If
Next
End Sub
- - - - - -
これだと

あいうえおかきくけこさしすせそ
↓↓
あいうえおかきくけこ　←全角10改行
さしすせそ　<成功！>

あいうえお(かきくけこさし)すせそ
↓↓
あいうえお(かきくけ　←全角9.5改行
こさし)すせそ　<成功！>

あいうえお(かきくけ)こさしすせそ
↓↓
あいうえお(かきくけ　←全角9.5改行
)こさしすせそ　<失敗！！>

こうなってほしい↓。

あいうえお(かきくけ)　←全角10改行
こさしすせそ

改行の狭間に全角文字が来た場合は全角9.5文字ごとに改行。
それ以外は全角10文字ごとに改行。
このようにする物を教えてください。

回答No.3

BLUEPIXY · ベストアンサー

>あいうえお(かきくけこ　　←全角10.5改行
おっしゃるとおりですね、すみません。
修正してみました

Public Sub test()
Dim Tmp As Range, Cha As Long, Num As Long, CSize As Integer
Dim STR As String, MdTmp As String
Num = 0
STR = ""
For Each Tmp In Selection
For Cha = 1 To Len(Tmp.Value)
MdTmp = Mid(Tmp.Value, Cha, 1)
CSize = IIf(Asc(MdTmp) >= 0, 1, 2)
If Num + CSize > 20 Then '２０を越えてしまう場合
STR = STR + vbLf + MdTmp
Num = CSize
ElseIf Num + CSize = 20 Then 'ちょうど２０の場合
STR = STR + MdTmp + vbLf
Num = 0
Else
STR = STR & MdTmp
Num = Num + CSize
End If
Next
If Right(STR, 1) = vbLf Then
STR = Left(STR, Len(STR) - 1)
End If
Tmp.Value = STR
Num = 0
STR = ""
Next
End Sub

お礼

再度回答ありがとうございます～～！
スクリプト(と言って良いのですよね)を完全に理解できたわけではありませんが，できますね。スゴイ。

なるほど，場合分けをすれば良かったのですか。目から鱗です。

If Num >= 20 Then
でもなく
If Num > 20 Then
でもなくその間
If Num >==== 20 Then
こんなのか欲しい！

とあるわけない数を考えてしまい，
これではいかんと，全く別法を探していました。

実は以前に，BLUEPIXYさんには，
http://oshiete1.goo.ne.jp/kotaeru.php3?q=1634838
　↑教えて！goo　　↓OKwave　　(同じです)
http://okwave.jp/kotaeru.php3?q_id=1634838
でもお世話になっております。

私は，いつもは回答ばかりで，質問はめったにしませんが，また質問する際はよろしくお願いします。
ありがとうございました。

回答No.2

BLUEPIXY

プログラムがうまく動かない原因は、LenB("(")が2になる（最近のシステムでは文字コードがユニコードのため？）です。
修正してみました。
Public Sub test()
Dim Tmp As Range, Cha As Long, Num As Long
Dim STR As String, MdTmp As String
Num = 0
STR = ""
For Each Tmp In Selection
For Cha = 1 To Len(Tmp.Value)
MdTmp = Mid(Tmp.Value, Cha, 1)
Num = Num + IIf(Asc(MdTmp) >= 0, 1, 2)
If Num >= 20 Then
STR = STR + MdTmp + vbLf
Num = 0
Else
STR = STR & MdTmp
End If
Next
If Right(STR, 1) = vbLf Then
STR = Left(STR, Len(STR) - 1)
End If
Tmp.Value = STR
Num = 0
STR = ""
Next
End Sub

補足

回答＆考えていただきありがとうございます。

書いてくださったマクロは格好もよく，感謝しています。
でも，回答してくださったマクロを実行すると，

あいうえお(かきくけこさしすせそ)
↓↓
あいうえお(かきくけこ　　←全角10.5改行
さしすせそ)

となってしまいます。

次のような場合はOKなのですが。

あいうえおかきくけこさしすせそ
↓↓
あいうえおかきくけこ　　←全角10改行
さしすせそ　　　<成功！>

あいうえお(かきくけ)こさしすせそ
↓↓
あいうえお(かきくけ)　　←全角10改行
こさしすせそ　　　<成功！>

つまり，最初に質問で書いたものの，

　' この↓(20)で改行文字数変更
　If Num >= 20 - 1 Then

ここの部分を

　' この↓(20)で改行文字数変更
　If Num >= 20 Then

とした場合と同じになってしまいます。
全角10文字を越えてはダメなのです。

データは全角文字と半角文字が混ざっていて，どちらかというと全角文字の方が多いため，

あいうえお(かきくけ)こさしすせそ

という具合に，ちょうど全角10の手前に半角文字が来ることより，

あいうえお(かきくけこさしすせそ)

という具合に，全角10文字目の境界に全角文字がぶち当たる確率の方が大きいので，
　If Num >= 20 - 1 Then　にして，確率的には多い方をクリアさせているわけです。
また絶対に全角10文字を越えないという第１条件もクリアさせています。
この場合，境界にぶち当たっている文字は「こ」です。

確率的には多く，
絶対にエラーにはならない方でクリアさせていますが，実際はどちらの場合もあるので，

あいうえお(かきくけ)　←全角10改行
こさしすせそ

あいうえお(かきくけ　←全角9.5改行
こさしすせそ)

にしたいわけです。

日本語で言うと簡単で，
基本的に全角10文字ずつで改行。
改行の境界に全角文字が来た場合は10文字を越えないように，手前の全角9.5文字改行。
なのです。　困った…・・・。

回答No.1

bdr

' この↓(20)で改行文字数変更
　　If Num >= 20 - 1 Then
を
　　' この↓(20)で改行文字数変更
　　If Num > 20 Then
になおせば良いのでは？

現状は19バイト以上で改行となっているので、20バイトより大きければ改行とすればよいのでは？

お礼

ありがとうございました。
なんとかなりました。今後ともよろしくお願いします。

補足

回答ありがとうございます～！

そうすると，

あいうえお(かきくけこさし)すせそ
↓↓
あいうえお(かきくけこ　←全角10.5改行
さし)すせそ　<失敗！>

になるのですよ（涙）。