エクセルにて入力フォームを作成しているのですが、1行に対する入力文字数の制限とそれをオーバーした場合に自動で改行するマクロを知りたいです。
例えばA1セルに30文字で入力制限しそれ以上の入力があれば自動でA2セルに改行するというようなものです。
入力フォームなので複数行にわたってしまうため、A1セルのみではなくその下のA2セルA3セル...と複数の指定セルで同じ作業をさせたいです。
入力する際は全角半角が混在してしまうので、合わせて30文字ではなく半角は0.5文字というようにしたいです。
またセルは結合して作成しているのでJustifyは使えませんでした。使えたら楽だったんですが。それとも使い方間違えたかな。。。
いろいろと探してみたのですが、ちょうど自分の作りたいものに合うものが調べられず質問しました。
ご教授いただけると助かります。
No.5
- 回答日時:
No.1・4です。
たびたびごめんなさい。
大勢にほとんど影響はないのですが・・・
前回のコードを2ヶ所訂正してください。
5行目と7行目に
>Selection
がありますが
>Target
にしてください。
その行を選択しているかどうかが不明ですし、
A列のセル変更があったセルに対して実行されるマクロになりますので、
厳密にいえば「Target」の方が正しい使い方だと思います。
何度も失礼しました。m(_ _)m
No.4
- 回答日時:
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
No.3ベストアンサー
- 回答日時:
大昔に作成したのをアレンジしていたら、いつの間にか賑わっていますね。
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
No.2
- 回答日時:
一応、もう一例を参考までに。
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]の内容をA1セルから順に書き出すようにしています。
ただし、
> 入力する際は全角半角が混在してしまうので、合わせて30文字ではなく半角は0.5文字
これも一応考慮してはいますが、
「切り出した部分に半角文字(記号)が奇数個だった場合」にはきっと不都合が発生します。
この考慮は全くしていません。
考慮ももちろん可能だとは思いますが、
それならば「すべてを全角に置き換えて30文字」の方が楽かなぁ、と思いますし。
まぁ、この辺は好みで使い分けてください。
※Justifyは列幅・フォントなどによって結果が変わってしまいますから
> 30文字で入力制限し
と言う条件があるならオススメはあまりしません。
この回答への補足
最初はネットで見つけてきたマクロを使って半角も全て全角に変換して書き込まれるようにしたのですが、「半角は半角、全角は全角になるようにしてくれ」と言われたので今回質問させていただきました。
補足日時:2013/07/24 21:08No.1
- 回答日時:
こんばんは!
一例です。
画面左下の操作したい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文字以上(3行にまたがる長さの文字列)は考慮していません。
こんなんではどうでしょうか?m(_ _)m
この回答への補足
もし60文字以上にしようとするならどこを変更すれば良いのでしょうか?
> If LenB(StrConv(.Value, vbFromUnicode)) > 60 Then
や
> If cnt = 60 Then
で指定しているようでは無いようなので。
それとも数値では無いところで指定してあるのでしょうか?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) セルに入力した小文字アルファベット、数字を大文字表示させるには? 3 2022/07/13 10:01
- Excel(エクセル) エクセルで”入力シート”の文字書式の変更を”出力シート”で同じ文字書式で印刷したいです。VBA希望 4 2023/04/24 11:07
- Excel(エクセル) 条件に合った数値の合計を表示させたい関数と条件指定の方法 3 2023/05/13 16:07
- Excel(エクセル) エクセルで、特定のセルの内容を更新すると、別の特定セルに 更新日付が自動的に表示させる方法はあります 1 2022/11/14 21:03
- Excel(エクセル) exel 漢字・英数字混在セルの入力規則 5 2022/04/03 11:08
- Excel(エクセル) Excel 関数 数式 について 2 2022/09/02 21:45
- Excel(エクセル) 一つのセルに複数の関数を入力する方法 4 2022/09/30 13:42
- Visual Basic(VBA) エクセルVBAについて 2 2023/01/31 16:21
- Excel(エクセル) 【再度】Excelの関数について教えてください。 4 2023/07/28 13:06
- Excel(エクセル) 【EXCEL】=セル&セルが上手く表示できない。 7 2022/09/04 21:32
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
A1セルに入力したら、入力時間...
-
参照先セルに値が入っていない...
-
Excelで同じセルに箇条書きをし...
-
IF関数で0より大きい数値が入力...
-
値を入力後、自動的にアクティ...
-
エクセルで既に入力してある文...
-
yyyy/mm/ddからyyyy/mmへの変換
-
エクセルで複数の条件で掛け算...
-
エクセルで時間の判定をしてい...
-
Excel:文字と数字の組合せ、次...
-
エクセルの数式で計算結果に文...
-
空白でないセルの値を返す方法...
-
Excelでセルに入力されたカラー...
-
エクセルで、特定のセルの内容...
-
マイナス同士の前年比
-
【エクセル】指定したセルに入...
-
Excel 分数の分子を小数点で表...
-
エクセルで10分ごとの時刻の...
-
Excel書式設定が24時間以上の設...
-
EXCELのセル上のURLを...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
A1セルに入力したら、入力時間...
-
Excelで同じセルに箇条書きをし...
-
参照先セルに値が入っていない...
-
IF関数で0より大きい数値が入力...
-
エクセルで既に入力してある文...
-
Excel:文字と数字の組合せ、次...
-
空白でないセルの値を返す方法...
-
値を入力後、自動的にアクティ...
-
エクセルで時間の判定をしてい...
-
yyyy/mm/ddからyyyy/mmへの変換
-
Excelでセルに入力されたカラー...
-
エクセルの数式がかぶって、選...
-
エクセルで、特定のセルの内容...
-
エクセルで複数の条件で掛け算...
-
マイナス同士の前年比
-
入力したところまでを自動的に...
-
EXCELのセル上のURLを...
-
excel 関数にて文字を0として認...
-
バーコードが読み取れない原因...
-
ExcelVBAでセルを編集状態にす...
おすすめ情報