セル内の行数で行の高さを変更

質問

セルA1を調べてその行の高さを変更するように下記のとおり
記述したのですが、これを複数行（例えば１～１０行）繰り返すようにする（調べるセルは各行のＡ列）にはどのように記述すればよいでしょうか？

ご教示どうぞよろしくお願いします。

Sub 行高変更()
Dim TextA As Variant

TextA = Range("A1").Text
TextA = Split(TextA, vbLf, , vbBinaryCompare)

RowA = UBound(TextA) + 1

If RowA = 1 Then
Rows(1).RowHeight = 20
ElseIf RowA = 2 Then
Rows(1).RowHeight = 30
ElseIf RowA = 3 Then
Rows(1).RowHeight = 40
ElseIf RowA = 4 Then
Rows(1).RowHeight = 50
ElseIf RowA = 5 Then
Rows(1).RowHeight = 60
End If

End Sub

回答No.4

end-u · ベストアンサー

>のところですが、「B2～B10」と限定したい場合は
>For～Nextで出来ますでしょうか？
前述したように、
『タテ方向の結合がなく、ヨコ方向の結合列数が同じ』
この条件ならLoop処理しなくても良いです。
>..「B2～B10」と限定..
結合範囲も含めると、例えば『B2:D10』と限定するという意味でしょうか？

Sub test2()
　　With ActiveSheet.Range("B2:D10")
　　　　.UnMerge
　　　　.VerticalAlignment = xlTop
　　　　.HorizontalAlignment = xlCenterAcrossSelection
　　　　.WrapText = True
　　　　.EntireRow.AutoFit
　　　　.Merge across:=True
　　　　.HorizontalAlignment = xlLeft
　　End With
End Sub

ヨコ方向の結合列の数が、それぞれの行で違う場合はLoop処理になります。

Sub test3()
　　Dim r As Range

　　Application.ScreenUpdating = False
　　For Each r In ActiveSheet.Range("B2:B10")
　　　　With r.MergeArea
　　　　　　.UnMerge
　　　　　　.VerticalAlignment = xlTop
　　　　　　.HorizontalAlignment = xlCenterAcrossSelection
　　　　　　.WrapText = True
　　　　　　.EntireRow.AutoFit
　　　　　　.Merge across:=True
　　　　　　.HorizontalAlignment = xlLeft
　　　　End With
　　Next
　　Application.ScreenUpdating = True
End Sub

お礼

ご回答ありがとうございます。

>結合範囲も含めると、例えば『B2:D10』と限定するという意味でしょうか？

はい、そういう意味です。
test3は試していませんが、test2で動作確認出来ました。

ただ、結合セルを解除した時点で、セル内文字が折り返し状態になっていると
その高さで調整してから、結合になるので、１行でも行の高さが高くなる時があります。
なるときと、ならない時があるので原因がよくわからないのですが。。。

とりあえずtest2を使用したいと思います。
ありがとうございました。

回答No.3

end-u

規則正しく結合された範囲の場合。
例えば
・タテ方向の結合がなく、複数列のヨコ方向の結合。
・結合範囲の各行の結合列数は同じ。
こういう条件だったら簡易的に以下のコードでもいけます。
セル内改行なしの「折り返して全体を表示」に対応します。

'B:D列の結合で、１行目からB列最終行まで。
Sub test()
　　With ActiveSheet
　　　　With .Range("D1", .Cells(.Rows.Count, "B").End(xlUp))
　　　　　　.UnMerge
　　　　　　.VerticalAlignment = xlTop
　　　　　　.HorizontalAlignment = xlCenterAcrossSelection
　　　　　　.WrapText = True
　　　　　　.EntireRow.AutoFit
　　　　　　.Merge across:=True
　　　　　　.HorizontalAlignment = xlLeft
　　　　End With
　　End With
End Sub

お礼

ありがとうございました。

補足

ご回答ありがとうございます。

一度結合を解除するんですね。
なるほど！
勉強になります。

ちなみに
「With .Range("D1", .Cells(.Rows.Count, "B").End(xlUp))」
のところですが、「B2～B10」と限定したい場合は
For～Nextで出来ますでしょうか？

回答No.2

mu2011

一例です。

Sub sample()
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 1) <> "" Then
texta = UBound(Split(Cells(i, 1), vbLf)) + 1
Rows(i).RowHeight = 10 * texta + 10
End If
Next
End Sub

お礼

ご回答ありがとうございます。

「For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row」
の「To」のあとは数字でも出来ました。

行高は行数を１０倍してそれに１０を足すってことですね。
こういうやり方もあるんですね！

大変参考になりました！

ありがとうございました。

回答No.1

utun01

こういうことでしょうか。
A1～A50までの場合です。
ちなみに高さは自動調整にしています。

Sub test()
Set sht = ActiveSheet
Set rng = sht.Range("A1:A50")
For Each cell In rng
cell.EntireRow.AutoFit
Next
End Sub

お礼

「AutoFit」はやはり結合セルでは動作しないみたいでした。
できないことはないみたいですが、大量の記述が必要な様ですので
諦めて、end-uさんに回答いただいたものを参考にしてみます。

ありがとうございました！

補足

ご回答ありがとうございます。
うまく動作しました。

今は「A列」を指定していますが、これを「B列以降で結合セル」を指定
すると動作しませんでした。

「AutoFit」は結合セルでは動作しないというのをネットで見たのですが
やっぱり無理なのでしょうか？

追加で質問してすいませんが、よろしくお願いします。