エクセルのセル内で改行した場合の行数および行ごとの文字数？

質問

エクセル２０００です。
セルをいくつか結合させ、その中にAlt+Enterで改行した文字列があります。
全部で何行あり、各行は何文字かを調べる関数またはVBAはありますか？

回答No.6

komet163 · ベストアンサー

なんどもすいません。
コード拝見させていただきました。Max関数で処理してるのがスマートですね。
蛇足ながら、もし処理目的を５行以上にするときは、

If UBound(sText) > 1 Then 行2 = Len(sText(1))
If UBound(sText) > 2 Then 行3 = Len(sText(2))
<中略>
maxd = Application.WorksheetFunction.Max(行1, 行2, 行3, 行4, 行5)
MsgBox maxd

の部分を

Dim LineLen() As Long
ReDim LineLen(UBound(sText))
For i = 0 To UBound(sText)
LineLen(i) = Len(sText(i))
Next
maxd = Application.WorksheetFunction.Max(LineLen)
MsgBox maxd

にすると行数に制限無くMAX値を求められます。

お礼

重ね重ねありがとうございます。
For Next使いながら代入も出来ちゃうんですね！

とっても勉強になりました。
これからも見かけたらまたご指導のほどよろしくお願い申し上げます。

回答No.7

an_inack

最後の横レス失礼します。
an_inackです。

・データ行数は5行と決まっている
・1行最大値48文字を超えたらメッセージ表示

て、ことなのかな？

お書きになられたコードで問題なく動くようであれば
そのままでOKなんじゃないかなと思います。
お疲れ様でした（ｗ

参考までに、こんな書き方もできるってことで。

'If UBound(sText) > 1 Then 行2 = Len(sText(1))
'If UBound(sText) > 2 Then 行3 = Len(sText(2))
'If UBound(sText) > 3 Then 行4 = Len(sText(3))
'If UBound(sText) > 4 Then 行5 = Len(sText(4))
'
'maxd = Application.WorksheetFunction.Max(行1, 行2, 行3, 行4, 行5)
'MsgBox maxd
'
'If maxd > 48 Then
'MsgBox "48文字を超える行がありまするぅ。　", vbExclamation, " 確認"
'End If

この部分ですが

　↓↓↓↓

'各行ごとにMax48文字チェック
maxd = 0
For i = 0 To UBound(sText)
If Len(sText(i)) > 48 Then
MsgBox i + 1 & "行目で48文字超えとるがな", vbExclamation, " 確認"
Exit Sub
End If

'最大値を変数に欲しいなら
If Len(sText(i)) > maxd Then
maxd = Len(sText(i))
End If
Next
MsgBox "最大文字数は" & maxd & "文字なり。"

こんなんしてみました。

質問者さんとの違いは、
すべての行の文字数を変数に取得してから、
最大値をとって、Max文字数チェックをする部分。

私の場合は、1行ずつチェックして、
1行でもMax超えてたら処理抜けてることですかね。

お礼

うっひゃあ！
なんと最大値も変数に取得できるんですね。

すごいです。

回答No.5

komet163

＃１です。
>>存在しない行
了解しました。＃１で提示したものは、
セル内文字を改行をセパレータに配列に取り込む方法、
その配列の次元数が行数、配列の各要素が各行に対応していることを示す例文です。
MsgBox で表示するのでしたら、＃３の例外処理を加味して以下のようされてはどうでしょう。

Sub Macro1()
Dim sText As Variant
Dim rRng As Range
Dim sMsg As String
Dim i As Long
On Error Resume Next
Set rRng = Selection
If Err Then
MsgBox "セルを選択して実行してください。"
Exit Sub
End If
On Error GoTo 0
sText = rRng.Cells(1, 1).Text
If sText = "" Then
MsgBox "文字が入力されていません。"
Exit Sub
End If
sText = Split(sText, vbLf, , vbBinaryCompare)
sMsg = "行数 : " & UBound(sText) + 1 & vbLf
For i = 0 To UBound(sText)
sMsg = sMsg & "行" & i + 1 & " : " & Len(sText(i)) & "文字" & vbLf
Next
MsgBox sMsg
End Sub

お礼

何度もありがとうございます。

こんな感じでやってみました。

Dim sText As Variant
sText = Range("通信欄").Text
If Len(Trim(sText)) = 0 Then
MsgBox "通信文がありませぬぅ。　", vbCritical, "　Sorry !!"
Exit Sub
End If

sText = Split(sText, vbLf, , vbBinaryCompare)

行数 = UBound(sText) + 1

If 行数 > 5 Then
MsgBox "５行を超えていますぅ！　", vbCritical, "　Sorry !!"
Exit Sub
End If

行1 = Len(sText(0))

If UBound(sText) > 1 Then 行2 = Len(sText(1))
If UBound(sText) > 2 Then 行3 = Len(sText(2))
If UBound(sText) > 3 Then 行4 = Len(sText(3))
If UBound(sText) > 4 Then 行5 = Len(sText(4))

maxd = Application.WorksheetFunction.Max(行1, 行2, 行3, 行4, 行5)
MsgBox maxd

If maxd > 48 Then
MsgBox "48文字を超える行がありまするぅ。　", vbExclamation, " 確認"
End If

直すべきところがありましたらご教示くださいませ。

回答No.4

an_inack

#1さんの書かれたコードが何をしているか
簡単にですが見てみましょう。

sText = Split(sText, vbLf, , vbBinaryCompare)

ここではsTextという変数に、
指定されたセルの値を、
改行を区切り文字として配列に取得しています。

たとえばセル内に2行あったとすると、
sText(0)
sText(1)
にまで値が入ります。

ちなみに、sText(2)には値がありませんから、
当然使おうとするとエラーになります。

>If IsError(Len(sText(2))) Then
>　MsgBox "行がないです。"
>Else
>　MsgBox "行 3:" & Len(sText(2)) & "文字"
>End If

でエラーになるのは1行目で存在しない
sText(2)を指定しているためです。

このエラーを回避したければ、
存在する配列分処理をするよう書けばいいと思います。

Dim sText As Variant
Dim i As Integer

sText = Range("通信欄").Text
sText = Split(sText, vbLf, , vbBinaryCompare)

For i = 0 To UBound(sText)
MsgBox "行" & i + 1 & "：" & Len(sText(i)) & "文字"
Next

詳しくはヘルプ、またはVBAのレクチャーサイトなどで、
「配列」をキーワードに調べてみると、
知識が深まると思いますよ～！

お礼

For i = 0 To UBound(sText)
MsgBox "行" & i + 1 & "：" & Len(sText(i)) & "文字"
Next
なるほど、これはいいですね！・・・・・と思ったのですが、実際はメッセージボックスではなく変数に代入しているので使えないですよね？
でも「存在する配列分処理をするよう書けばいい」とのアドバイスで、

If UBound(sText) > 1 Then 行2 = Len(sText(1))
If UBound(sText) > 2 Then 行3 = Len(sText(2))
If UBound(sText) > 3 Then 行4 = Len(sText(3))
If UBound(sText) > 4 Then 行5 = Len(sText(4))

としてみましたら、無事回避できました。
ありがとうございました。

回答No.3

komet163

＃１です。
>というか、存在しない行のところでエラーになります。
がちょっと不明なんですが、取りあえず On Error Resume Next で
いいと思います。以下はそれ以外に思いついたものです。

Dim sText As Variant
Dim rRng As Range

On Error Resume Next
Set rRng = Selection
If Err Then
'例外処理:セル以外を選択している
End If
On Error GoTo 0

sText = rRng.Cells(1, 1).Text
If sText = "" Then
'例外処理：空白セル
End If

sText = Split(sText, vbLf, , vbBinaryCompare)
If UBound(sText) < 1 Then
'例外処理：セル内改行していない
End If

お礼

If IsError(Len(sText(2))) Then
MsgBox "行がないです。"
Else
MsgBox "行 3:" & Len(sText(2)) & "文字"
End If

とやっても、同じでした。

補足

>>というか、存在しない行のところでエラーになります。
>がちょっと不明なんですが、

たとえば、セル内に2行しかない場合、

Dim sText As Variant
sText = Range("通信欄").Text
sText = Split(sText, vbLf, , vbBinaryCompare)
MsgBox "行数:" & UBound(sText) + 1
MsgBox "行 1:" & Len(sText(0)) & "文字"
MsgBox "行 2:" & Len(sText(1)) & "文字"
MsgBox "行 3:" & Len(sText(2)) & "文字"'←ここでエラー

「インデックスが有効範囲にありません」と出ます。

回答No.2

maruru01

こんにちは。maruru01です。

数式（関数）での方法です。
かなり面倒になります。

仮に、A1:B5が結合されていて文字列が入力されているとします。
C1に行数、D1から下の行へ順に各行の文字数を表示します。
まず、C1に、

=LEN($A$1)-LEN(SUBSTITUTE($A$1,CHAR(10),))+1

と入力します。
次に、D1に、

=IF(ROW(A1)<=$C$1,FIND("?",SUBSTITUTE(CHAR(10)&$A$1&CHAR(10),CHAR(10),"?",ROW(A2)))-FIND("?",SUBSTITUTE(CHAR(10)&$A$1&CHAR(10),CHAR(10),"?",ROW(A1)))-1,"")

と入力して、下の行へコピーします。

ちょっと補足しますと、結合されたセルに入力すると左上のセルに値が入ります。
（したがって、数式中の"$A$1"は結合セルの値を参照しています。）
D1の数式の"$C$1"は1つ目の行数のセル（絶対参照）のことです。
さらに、D1の数式中のROW関数の引数の"A2"、"A1"は、数式を入力するセルがD1でなくても、調べるセル（の左上）がA1でなくても、常にA2、A1を（相対参照で）指定して下さい。
また、D1の数式中の"?"は、仮に変換する文字で、元の文字列中に絶対に存在しない文字を使用して下さい。
そういう文字がどうしてもない場合は、
"?"→CHAR(9)
にして下さい。

VBAが分かるのであれば、No.1の方とかのようにVBAでやった方がいいと思います。

お礼

ありがとうございます。
関数ではこんなおおごとになってしまうんですね！
VBAでやることにします。

回答No.1

komet163

こんにちは、こんな感じですか？

Dim sText As Variant
sText = Selection.Cells(1, 1).Text
sText = Split(sText, vbLf, , vbBinaryCompare)
MsgBox "行数:" & UBound(sText) + 1
MsgBox "行 1:" & Len(sText(0)) & "文字"
MsgBox "行 2:" & Len(sText(1)) & "文字"
・・・・以下同様

エラートラップとか書いてませんけど。

お礼

ありがとうございます。
これでなんとかなりそうなのですが、改行していないとというか、存在しない行のところでエラーになります。

On Error Resume　Next以外に防ぐ方法はあるのでしょうか？