世の中には器用な人がいて、Excelをワープロ風に使う人がいます。
セルA1に文を入力し、ある文字数を超えると、続きをセルA2に入力します。
例えば次のような感じです。
これを手作業でやっているわけです。後から文字を挿入するときは一つ一つずらします。
面白そうなのでマクロを作ってみました。特定のセルが変わったときにマクロを実行する方法を使います。
セルA1:A50の範囲で文字を入力します。
5文字を超えると自動的に5文字でカットし、超えた部分を下のセルにセットします。
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Row <= 50 And Target.Column = 1 Then
Call 改行
End If
Application.EnableEvents = True
End Sub
Sub 改行()
c = 1
mojisu = 5
a = Range("a1:a50")
For r = 1 To UBound(a)
t = a(r, c)
If Len(t) > mojisu Then
a(r, c) = Left(t, mojisu)
a(r + 1, c) = Mid(t, mojisu + 1) & a(r + 1, c)
End If
Next r
Range("a1:a50") = a
End Sub
Application.EnableEvents = False
If Target.Row <= 50 And Target.Column = 1 Then
Call 改行
End If
Application.EnableEvents = True
End Sub
Sub 改行()
c = 1
mojisu = 5
a = Range("a1:a50")
For r = 1 To UBound(a)
t = a(r, c)
If Len(t) > mojisu Then
a(r, c) = Left(t, mojisu)
a(r + 1, c) = Mid(t, mojisu + 1) & a(r + 1, c)
End If
Next r
Range("a1:a50") = a
End Sub
使うことはないと思いますが何かに応用できるかもしれないので貼っておきます。
2016年1月7日追記
「シート全体でできないか」というコメントをいただきました。
シート全体は無理ですが複数の列を対象に処理することができると思います。
上の例ではA列(1列)だけを対象にしていますが、次の例ではJ列(10列)までを対象にしています。
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Row <= 50 And Target.Column <= 10 Then
Call 改行
End If
Application.EnableEvents = True
End Sub
Sub 改行()
mojisu = 5
a = Range("a1:j50")
For c = 1 To UBound(a, 2)
For r = 1 To UBound(a, 1)
t = a(r, c)
If Len(t) > mojisu Then
a(r, c) = Left(t, mojisu)
a(r + 1, c) = Mid(t, mojisu + 1) & a(r + 1, c)
End If
Next r
Next c
Range("a1:j50") = a
End Sub
Application.EnableEvents = False
If Target.Row <= 50 And Target.Column <= 10 Then
Call 改行
End If
Application.EnableEvents = True
End Sub
Sub 改行()
mojisu = 5
a = Range("a1:j50")
For c = 1 To UBound(a, 2)
For r = 1 To UBound(a, 1)
t = a(r, c)
If Len(t) > mojisu Then
a(r, c) = Left(t, mojisu)
a(r + 1, c) = Mid(t, mojisu + 1) & a(r + 1, c)
End If
Next r
Next c
Range("a1:j50") = a
End Sub
2020年10月27日
「改行後に文字を追加、削除したとき、自動的に改行できないか」というコメントいただきました。
「改行()」を全面的に書き換えました。
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Row <= 50 And Target.Column = 1 Then
Call 改行
End If
Application.EnableEvents = True
End Sub
Sub 改行()
Dim moto As String
c = 1
mojisu = 5
a = Range("a1:a50")
moto = ""
For r = 1 To UBound(a)
t = a(r, c)
moto = moto & t
Next r
For r = 1 To UBound(a)
If Len(moto) >= mojisu Then
bubun = Left(moto, mojisu)
moto = Right(moto, Len(moto) - mojisu) 'Mid(moto, mojisu, 1000)
Else
bubun = moto
moto = ""
End If
a(r, c) = bubun
Next r
Range("a1:a50") = a
End Sub
Application.EnableEvents = False
If Target.Row <= 50 And Target.Column = 1 Then
Call 改行
End If
Application.EnableEvents = True
End Sub
Sub 改行()
Dim moto As String
c = 1
mojisu = 5
a = Range("a1:a50")
moto = ""
For r = 1 To UBound(a)
t = a(r, c)
moto = moto & t
Next r
For r = 1 To UBound(a)
If Len(moto) >= mojisu Then
bubun = Left(moto, mojisu)
moto = Right(moto, Len(moto) - mojisu) 'Mid(moto, mojisu, 1000)
Else
bubun = moto
moto = ""
End If
a(r, c) = bubun
Next r
Range("a1:a50") = a
End Sub
コメント
教えてください。
自動的に「改行」するマクロを使用させていただきたいですが、シート全体を全て改行出来るようにするには、マクロのどの部分を変更したら良いですか？
＞匿名さん
本文に追記しました。
ご期待に添えるかどうか。
ありがとうございます！
＞匿名さん
お役に立てて何よりです。
はじめまして。長文で失礼致します。
職場でExcelで書類を作成して提出することが多々あるのですが、印刷すると右端が切れており、それをチマチマ修正しての繰り返しで、うんざりしながら早数年。
自動で改行してくれたらなとwebで検索しまくった結果、このページにたどり着き、感激しております。すごいです。まさにこれです。これを探し求めていました。
本当にありがとうございます。
欲望というのは恐ろしいもので、ド厚かましいお願いをしてもよろしいでしょうか？
自動改行機能はそのままで、数文字削った分を詰めるという機能の実装はできないでしょうか？
無理難題だとは思いますが、ご教授いただければ幸いです。
例）
どこで生れ｜
たかとんと｜
見当がつか｜
ぬ。何でも｜
↓「とんと」を削除
どこで生れ｜
たか見当が｜
つかぬ。何｜
でも
匿名希望さん
少し試しましたが失敗しました。
時間があればできると思います。
匿名希望さん
作ってみました。
試していただけると幸いです。
返事が遅くなり申し訳ありません。
早々に作っていただけたのですね。
UPして頂いた後、即使わせていたっだきました。
すごいです。感動です。
削除した分だけ文字が自動的に詰まります。本当にすごいです。
誠に申し訳ございませんが、あともう少しお付き合いいただいてもよろしいでしょうか。
次の段落に意図的に変えたい時も文字が詰まってしまうので、そのセル内の指定文字数を超えていない状況であっても、『次の行から書き出した時（意図的に改行させたい時）』や『意図的に空白行を入れた時』は詰めない、なんて都合のいい事は難しいでしょうか？
例）
どこで生れ｜
たかとんと｜
見当がつか｜
ぬ。何でも｜
薄暗いじめ｜
じめした所｜
でニャーニ｜
ャー泣いて｜
↓
どこで生れ｜
たかとんと｜
見当がつか｜
ぬ。 ｜
何でも薄暗｜
いじめじめ｜
した所でニ｜
ャーニャー｜
泣いて ｜
度々の長文、度々の無理難題
大変申し訳ございませんが、ご教授いただければ幸いです。
匿名希望さん
強制的に改行する部分に記号を入れる方法が考えられます。
見当がつかぬ。／何でも薄暗い
↓
見当がつか
ぬ。
何でも薄暗
い
早々の返事ありがとうございました。
なるほどですっ
改行する部分に記号を挿入する方法でやってみたいと思います。
ご親切にありがとうございました。
これでやっと煩わしい作業が快適になると思います。
本当にありがとうございました。
匿名希望さん
「／」などの改行記号を入れる方法でやってみようと思ったのですが結構面倒なので諦めました。
また改行記号を入れる方法だと「追加・削除時の自動更新」ができません。一度、「改行付き文字列」に変換してしまうと「／」が消えてしまうので「改行なし文字列」に戻せないからです。
[…] 以前、「自動的に「改行」するマクロ」を作りました。 指定した文字数で文字列を分割して各セルにセットするというマクロなのですが、意図して改行を入れることができませんでした。 しかしJavaScriptならば簡単なので作ってみました。 […]