エクセルで1行に入力文字数制限と自動改行

エクセルにて入力フォームを作成しているのですが、1行に対する入力文字数の制限とそれをオーバーした場合に自動で改行するマクロを知りたいです。
例えばＡ１セルに30文字で入力制限しそれ以上の入力があれば自動でＡ２セルに改行するというようなものです。

入力フォームなので複数行にわたってしまうため、Ａ１セルのみではなくその下のＡ２セルＡ３セル．．．と複数の指定セルで同じ作業をさせたいです。
入力する際は全角半角が混在してしまうので、合わせて30文字ではなく半角は0.5文字というようにしたいです。

またセルは結合して作成しているのでJustifyは使えませんでした。使えたら楽だったんですが。それとも使い方間違えたかな。。。

いろいろと探してみたのですが、ちょうど自分の作りたいものに合うものが調べられず質問しました。
ご教授いただけると助かります。

No.3 ベストアンサー 回答者： mitarashi 回答日時： 2013/07/24 01:05

大昔に作成したのをアレンジしていたら、いつの間にか賑わっていますね。

http://oshiete.goo.ne.jp/qa/3611973.html
UserFormの話なのか、最初からワークシートに入力するの判断しにくいですが、後者として作成しています。

動作としてはA列のあるセルに入力する（実用上の最大文字数の制限はありません）と、21～22バイト毎（全角半角の混じり具合によって異なる）に区切って一種の改行をし、最終行で編集モードになって継続して入力できるという、ワープロ紛いを目指したものです。ご参考まで。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim targetString As String
Dim i As Long, j As Long
Dim trimString As String
Dim currentCell As Range

Const limitLength As Long = 20

If TypeName(Target.Value) <> "String" Then Exit Sub
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub

Application.EnableEvents = False
Set currentCell = Target
targetString = Target.Value
If LenB(StrConv(targetString, vbFromUnicode)) > limitLength Then
j = 1
For i = 1 To Len(targetString)
trimString = Mid(targetString, 1, j)
If LenB(StrConv(trimString, vbFromUnicode)) > limitLength Then
currentCell.Value = trimString
Set currentCell = currentCell.Offset(1, 0)
currentCell.Activate
targetString = Right(targetString, Len(targetString) - Len(trimString))
j = 1
Else
j = j + 1
End If
Next i
currentCell.Value = trimString
End If
SendKeys "{F2}"
Application.EnableEvents = True
End Sub

この回答へのお礼

返答ありがとうございます。
入力文字数に制限がないので使い勝手が良さそうですね。参考にさせていただきますm(_ _)m

お礼日時：2013/07/24 21:01

No.5 回答者： tom04 回答日時： 2013/07/25 22:51

No.1・4です。

たびたびごめんなさい。
大勢にほとんど影響はないのですが・・・
前回のコードを2ヶ所訂正してください。

5行目と7行目に
＞Selection
がありますが
＞Target
にしてください。

その行を選択しているかどうかが不明ですし、
A列のセル変更があったセルに対して実行されるマクロになりますので、
厳密にいえば「Target」の方が正しい使い方だと思います。

何度も失礼しました。m（_ _）m

No.4 回答者： tom04 回答日時： 2013/07/25 22:39

No.1です！

文字数の制限なし！がご希望だというコトですので・・・
↓のコードに変更してみてください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, k As Long, cnt As Long, startRow As Long, endRow As Long, myStr As String, tmp
If Application.Intersect(Target, Range("A:A")) Is Nothing Or Target.Count <> 1 Then Exit Sub
If LenB(StrConv(Selection, vbFromUnicode)) > 60 Then
tmp = Selection
Application.EnableEvents = False
startRow = Selection.Row
endRow = Int(LenB(StrConv(tmp, vbFromUnicode)) / 60)
For k = startRow To startRow + endRow
cnt = 0
myStr = ""
For i = 1 To Len(tmp)
cnt = cnt + LenB(StrConv(Mid(tmp, i, 1), vbFromUnicode))
myStr = myStr & Mid(tmp, i, 1)
If cnt >= 60 Then
Exit For
End If
Next i
With Cells(k, "A")
.Value = myStr
.Offset(1) = Replace(tmp, myStr, "")
tmp = .Offset(1)
End With
Next k
Application.EnableEvents = True
End If
End Sub

※　今回もシートモジュールです。
※　No.2さんも指摘されていらっしゃいますが、半角英数（1バイト）の文字が偶数の場合は問題ないのですが、
奇数の場合は1バイト分だけ余計にその行内に表示されます。m（_ _）m

この回答へのお礼

ありがとうございます。使わせていただきます。
大変助かりましたm(_ _)m

お礼日時：2013/07/27 01:05

No.2 回答者： tsubuyuki 回答日時： 2013/07/23 23:47

一応、もう一例を参考までに。

Private Sub CommandButton1_Click()
Dim myText As String
　　　　myText = StrConv(TextBox1.Text, vbFromUnicode)
　　　　For i = 0 To Int(LenB(myText) / 60)
　　　　　　　　Range("A1").Offset(i, 0) = StrConv(MidB(myText, 60 * i + 1, 60), vbUnicode)
　　　　Next
End Sub

[CommandButton1]をクリックすると、
[TextBox1]の内容をＡ１セルから順に書き出すようにしています。

ただし、
> 入力する際は全角半角が混在してしまうので、合わせて30文字ではなく半角は0.5文字
これも一応考慮してはいますが、
「切り出した部分に半角文字（記号）が奇数個だった場合」にはきっと不都合が発生します。
この考慮は全くしていません。

考慮ももちろん可能だとは思いますが、
それならば「すべてを全角に置き換えて３０文字」の方が楽かなぁ、と思いますし。
まぁ、この辺は好みで使い分けてください。



※Justifyは列幅・フォントなどによって結果が変わってしまいますから
　> 30文字で入力制限し
　と言う条件があるならオススメはあまりしません。

この回答への補足

最初はネットで見つけてきたマクロを使って半角も全て全角に変換して書き込まれるようにしたのですが、「半角は半角、全角は全角になるようにしてくれ」と言われたので今回質問させていただきました。

補足日時：2013/07/24 21:08

No.1 回答者： tom04 回答日時： 2013/07/23 22:44

こんばんは！

一例です。

画面左下の操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストしてA列にデータを入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
Dim i As Long, k As Long, cnt As Long, myStr As String, tmp
If Application.Intersect(Target, Range("A:A")) Is Nothing Or Target.Count <> 1 Then Exit Sub
Application.EnableEvents = False
With Target
If LenB(StrConv(.Value, vbFromUnicode)) > 60 Then
tmp = .Value
For k = 1 To Len(tmp)
myStr = myStr & Mid(tmp, k, 1)
cnt = cnt + LenB(StrConv(Mid(tmp, k, 1), vbFromUnicode))
If cnt = 60 Then
Exit For
End If
Next k
.Value = myStr
.Offset(1) = Replace(tmp, .Value, "")
End If
End With
Application.EnableEvents = True
End Sub 'この行まで

※　60文字以上（３行にまたがる長さの文字列）は考慮していません。

こんなんではどうでしょうか？m（_ _）m

この回答への補足

もし60文字以上にしようとするならどこを変更すれば良いのでしょうか？

> If LenB(StrConv(.Value, vbFromUnicode)) > 60 Then
や
> If cnt = 60 Then
で指定しているようでは無いようなので。
それとも数値では無いところで指定してあるのでしょうか？

補足日時：2013/07/24 21:05