【Excel VBA】セル内に改行を挿入したい

Question

セル内で左から数えて10文字毎に改行（折り返し）させたいのですが、
どのようにコーディングすればよろしいでしょうか？

例）
セルA1の値が
"あいうえおかきくけこさしすせそたちつてとなにぬねの"
の場合、
"あいうえおかきくけこ
 さしすせそたちつてと
 なにぬねの"
としたいです。

※セルの値は、CSVから自動取得して貼り付ける仕様になっています。
　またセルの書式設定は、"折り返して全体を表示する"に事前に設定します

よろしくお願いします。

Wendy02 · Accepted Answer

こんばんは。「セル内で左から数えて10文字毎に改行（折り返し）させたいのです」「セルの書式設定は、"折り返して全体を表示する"に事前に設定します」この二つの条件では厳密には矛盾があります。「折り返して全体を……」という設定には、改行コードは入りません。また、全角と半角の違いがありますから、全角と半角は同じようにすることは出来ません。ここでは、全角という条件にさせていただきます。私のマクロは、先頭行の列を一回設定したら、後は、行をAutoFit（左端の色の付いたところの行の境目をダブルクリック) をすればよいだけです。列のAutoFit をしたら崩れる可能性があります。改行コードを入れたら、それも文字ですから、おそらくはずれるはずです。これは、たぶん、アプリが持つフォントとセルの関係で、VBAでは、正しく取れない部分がある難しい種類の問題だと思います。私の技術では、今のところ、統一係数を導き出すことが出来ません。たぶん、システム上の係数はあるはずだと思います。列の幅は、8.38 という表示でしたら、半角で8.38 文字表示できるということですから、２バイト文字だったら、それを半分にすればよいと考えがちですから、セル自体に、調整スペースらしきものがあるようです。それに、フォントの種類もあるはずです、一応、こちらでは、MSゴシック等幅フォントで試していますが、プロポーショナルでは試しておりません。うまく行かないようでしたら、解決するには、「係数」を、もう一度算出しないと出来ません。 Const dKT As String = "15,15.5,17.5,20,20.5,23,25.5" フォントが順に8,9,10,11,12,13,14　までの対応になっていますが、しかし、これは、スタイル側のフォントが、10～12までですから、それ以外は、調整しなおさないといけません。（デフォルトは、11です) 後、なるべくなら質問の条件をひっくり返さないようにしてください。今の条件のままでしたら、調整は可能です。 '--------------------------------------------- Sub TestAutoFit() 　　Dim iFnt As Double 'スタイルフォント　　Dim acFnt As Double　'アクティブセルフォント　　Dim arKt As Variant 　　Dim w As Double 　　Dim strText　As String 　　'フォント定数　8～14 まで　　Const dKT As String = "15,15.5,17.5,20,20.5,23,25.5" 　　Const iNUM As Integer = 10　'全角文字数　　　　arKt = Split(dKT, ",") 　　　　iFnt = ThisWorkbook.Styles("Normal").Font.Size 　　If iFnt < 10 Or iFnt > 13 Then 　　　MsgBox "設定できるのは、標準スタイル・フォント10～12までで、それ以外では、" & _ 　　　 "特別設定が必要です。", vbInformation 　　　Exit Sub 　　End If 　　With ActiveCell 　　strText = .Value 　　If Len(.Value) = 0 Then 　　　 MsgBox "セルが空で、実行できません。", vbInformation 　　　 Exit Sub 　　ElseIf LenB(StrConv(strText, vbFromUnicode)) = Len(strText) Then 　　　 MsgBox "半角が入っていると、現在のマクロでは調整できません。", vbInformation 　　　 Exit Sub 　　End If 　　　　If .WrapText = False Then 　　　　.WrapText = True 　　End If 　　 acFnt = .Font.Size 　　'スタイル・フォントは、8～14 まで。　　If acFnt > 7 And acFnt < 15 Then 　　　　.ColumnWidth = arKt(acFnt - 8) 　　　　　　End If 　　　 .EntireRow.AutoFit 　　End With End Sub

_Kyle · Answer

今更なんですが…。

#2さんのご回答で解決しているものと思って投稿を控えていたのですが、
改めて読んでみると、どうも私の書いていたコードとは少し異なる動作をするようなので、
屋上屋を架すようですが、一応参考までに。

●動作の概要
　A1セルの値を、10文字毎に、改行コード(LF)で区切って、A1セルにセットする

●動作上の相違点(#2さんのご回答との比較)
　・文字列の最後には改行をつけない。
　・文字列が10N+1文字(1,11,21…)の場合に最後の文字を消さない。

なお、私のコードでは主処理の部分をFunctionプロシージャとして切り出しています。
実際の運用はA1セルやアクティブセルに限るわけではないでしょうし、
決まって10文字毎に区切るとも限らないので。

'=======================↓　ココカラ　↓=======================
Sub Sample090615()
　Range("A1").Value = Insdiv(Range("A1").Value, 10, vbLf)
End Sub
'--------------------
Function Insdiv( _
　ByVal orgStr As String, _
　ByVal divCnt As Long, _
　ByVal divChr As String _
　) As String
　Dim rstStr　 As String
　Dim i　　　　As Long
　If divCnt < 1 Then Insdiv = orgStr: Exit Function
　i = 1
　Do
　　rstStr = rstStr & Mid(orgStr, i, divCnt) & divChr
　　i = i + divCnt
　Loop While i <= Len(orgStr)
　Insdiv = Left(rstStr, Len(rstStr) - Len(divChr))
End Function
'=======================↑　ココマデ　↑=======================

ご参考まで。

imogasi · Answer

参考
改行箇所で、Chｒ(10)を入れる。その位置の問題だけ。
Sub test01()
x = "あいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほ"
Range("A1") = x
y = Range("A1")
s = Mid(y, 1, 10)
i = 11
p1:
s = s & Chr(10) & Mid(y, i, 10)
i = i + 10
If i < Len(y) Then GoTo p1
Range("A1") = s
End Sub
＝＝＝
（１）セルの書式設定は、"折り返して全体を表示する"に事前に設定します
（２）MSP明朝のようなプロポーショナルフォントは設定しないほうがよい。上記で最後の「ほ」が改行されたように見えておかしいなと思ったら、Pフォントが原因だった。
（３）実際はA1セルだけではないので、A列について最終行まで全行繰り返してください。コードはありふれているので略。
またGOTOを使わないループに直してください。

okormazd · Answer

次のようにも、

Sub test()

Dim s As String, n As Integer, s2 As String, n1 As Integer, l As Integer

s = ActiveCell
n = Len(s)
s2 = ""
n1 = 1
l = 10

While n1 < n

s1 = Mid(s, n1, l) & Chr(10)
s2 = s2 & s1
n1 = n1 + l

Wend

ActiveCell = s2

End Sub

noname#99913 · Answer

文字のあるセルにカーソルを移動し、次のコードを実行してください。

Sub cut()

    moji = ActiveCell.Value
    
    mojisuu = Len(moji)
    
    If mojisuu > 10 Then
    
        ActiveCell.Value = ""
        
        For i = 1 To Int(mojisuu / 10)
            
            ActiveCell.Value = ActiveCell.Value & Mid(moji, i + (i - 1) * 9, 10)
        
            If Mid(moji, i + 1 + i * 9, 10) <> "" Then
                ActiveCell.Value = ActiveCell.Value & Chr(10)
            End If
        
        Next i
    
        ActiveCell.Value = ActiveCell.Value & Mid(moji, i + (i - 1) * 9, 10)

    End If

End Sub

【Excel VBA】セル内に改行を挿入したい

こんばんは。

今更なんですが…。

参考

次のようにも、

文字のあるセルにカーソルを移動し、次のコードを実行してください。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング