Excelマクロ・行の高さを自動調整したい

質問

データベースから抽出したExcelの人材情報リストから、VLOOKUP関数で情報を射影して、指定した人材を数人分連続で印刷するマクロを設定して、定型のプロフィールシートを作成しました。 
改良したい点として、人によって情報量が異なる項目があるので、特定の行（例えば5行目）の高さのみを自動調整するようにしたいのですが、どのようにすればよいでしょうか。 

VLOOKUP関数を使用しているからか、書式から行の自動調整を設定してみても１行の高さになってしまいます。 
マクロで一度に印刷できるようにしたので、一枚一枚レイアウトを修正しなくてもいいようにしたいです。 

VBA初心者ですので、宜しくお願いします。

回答No.5

real beatin（@realbeatin） · ベストアンサー

＃１,２,４です。＃４補足コメント拝見しました。

> なんだかとても難しそうですね…。
中の上ぐらい？と思います。

> 記述頂いたものをコピペして要指定◆の三か所を、
> (1)Const S = "プロフィールシート"
> (2)Set rWork = Columns("V").Resize(.Rows(.Rows.Count).Row)
> (3)For Each c In Range("J13:T13")　'　※試しに結合しているセル範囲J13：T13を入力してみました※
> と変えて実行してみました...
ご苦労様です。ご確認ありがとうございます。

> ...が、「エラー：1004アプリケーション定義またはオブジェクト定義のエラーです」というメッセージが出ました。
エラーの原因は既に特定され、対策も済みました。
原因は、指定した範囲には、[結合セル]の左上に当たる先頭セルがひとつもなかった為、
本題の処理以外の所でカウンタの数値が不適切になっていたことです。
こちらの想定漏れです。

> ちなみに、行の高さを自動調整したい結合セルは、F9:T9、F13:T13、F21:T21、F22:T22、F23:T23の５か所です。
一気に前が開けて見えて来ました。
　　Range("F9:T9,F13:T13,F21:T21,F22:T22,F23:T23")
のような書き方で、一括りに、そしてピンポイントに、セル範囲を指定することが
出来ました。

　●シートイメージが掴めたので、必要以上の処理が不要になったこと、
　●ご指摘のエラーへの対処
　●一部設計について、より簡単で堅実な方法を見つけたので改良（基本設計は同じ）
以上の理由から、＃４のマクロを書き換えましたので、丸々差し替えて
動作を試してください。

動作確認が済んだ所で、ご提示のマクロについて。
こちらでは動作の確認はしていませんが、
今回課題の[結合セル]の行高[自動調整]処理をするタイミングは、
　　Sheets("プロフィールシート").Range("A1").Value = 番号
　　' ■ココ！！■
　　Sheets("プロフィールシート").PrintOut
の間（PrintOutする直前）の行になります。
以下のマクロの名前を適当なものに変えて、
ご提示のマクロから、こちらの（課題の）マクロを呼び出すようにして下さい。
気になるとすれば、改ページが行高の変化の影響を受けないか、
ということぐらいで、今の処、問題なさそうと見込んでいます。

マクロの開発はエラーを重ねて進めることも多いので、
こちらが想定出来ていないことがあれば、またエラーが発生するかもしれません。
もし次にエラーに遭遇したら、
　　On Error GoTo ErrH_　'　エラートラップ
の先頭に一時的に ' を付けて（コメントブロックして）
再度実行してみて下さい。
その際、エラーメッセージへの応答で[デバッグ]を選択し、
マクロの記述のどの部分（エラー行が黄色になる）で
どんなエラーが発生しているかを確認してみてください。

楽観的にみてはいるのですが、何かあれば、遠慮なく、、、。

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub Re8919629_r()
Const S_SHT_NAME = "プロフィールシート"　'　要指定◆シート名は正確に◆
Dim rWork As Range　'　作業セル範囲
Dim rArea As Range　'　ループ用　各[結合セル]範囲全体
Dim sngColWid1st As Single　'　処理実行前の作業セル　の列幅
Dim sngColWid As Single　'　各[結合セル]範囲　の実効幅
Dim cnCol As Long　'　処理件数　カウンタ

　　If ActiveSheet.Name <> S_SHT_NAME Then Sheets(S_SHT_NAME).Select　'　処理対象シート　を選択状態に
　　With ActiveSheet.UsedRange　'　処理対象シートの内　使用中の範囲　を捉える
　　　　' ' 要指定◆一時的な作業列としてそれより右すべてが使用可能な列を指定（例ではＶ列）◆
　　　　' ' ◆但し、作業列は必ず印刷範囲の外であること◆
　　　　' ' 作業セル範囲を　必要な行数　変数に格納
　　　　Set rWork = Columns("V").Resize(.Rows(.Rows.Count).Row)　'
　　End With
　　sngColWid1st = rWork.ColumnWidth　'　処理実行前の作業セルの列幅　を確保

　　Application.ScreenUpdating = False　'　処理が遅くならないように　描画　停止
　　On Error GoTo ErrH_　'　エラートラップ

　　With Range("F9:T9,F13:T13,F21:T21,F22:T22,F23:T23")　'　要指定◆処理対象[結合セル]範囲　をRange型で指定◆
　　　　.WrapText = True　'　[折り返して全体を表示する]設定　の徹底
　　　　cnCol = 0 '　カウンタ　初期化
　　　　For Each rArea In .Areas　'　処理対象セル範囲の各[結合セル]範囲　を総当たりでループ
　　　　　　cnCol = cnCol + 1　'　処理する数をカウント
　　　　　　sngColWid = (rArea.Width * 4 / 3 - 5) / 8　'　各[結合セル]範囲の実効幅　を計算で求める
　　　　　　rArea.UnMerge　'　各[結合セル]範囲の[セルの結合]　を一時解除
　　　　　　With rWork.Cells(rArea.Row, cnCol)　'　各[結合セル]範囲と同じ行　未使用の作業列にあるセルを作業セルとして
　　　　　　　　rArea(1).Copy Destination:=.Cells　'　各[結合セル]範囲の先頭セル　をコピーして作業セルに貼付け
　　　　　　　　.Value = rArea(1).Value　'　各[結合セル]範囲の値　を作業セルの値としてトレース
　　　　　　　　.ColumnWidth = sngColWid　'　作業セルの実効幅　を各[結合セル]範囲の実効幅　に合わせる
　　　　　　End With
　　　　　　rArea.Merge　'　各[結合セル]範囲の[セルの結合]　を再設定
　　　　　　rArea.EntireRow.AutoFit　'　各[結合セル]範囲行高　を[自動調整]
　　　　　　rArea.RowHeight = rArea.RowHeight　'　作業セルを基準に[自動調整]された行高　を各[結合セル]範囲で確定する
　　　　Next
　　End With
　　If cnCol > 0 Then
　　　　With rWork.Resize(, cnCol)
　　　　　　.Clear　'　作業セル　をクリア
　　　　　　.ColumnWidth = sngColWid1st　'　列幅　を元に戻す。
　　　　End With
　　　　ActiveSheet.UsedRange　'　印刷範囲を変えない為にUsedRange　を元に戻す。
　　End If
ErrH_:
　　If Err Then MsgBox "エラー：" & Err.Number & vbLf & Err.Description　'　エラー時　のメッセージ
　　Application.ScreenUpdating = True　'　描画　再開
End Sub
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

お礼

ご丁寧なご回答、本当にありがとうございます。
ご教授いただいたマクロで無事に行の高さが自動調節されました！感動です。
教えていただいたマクロの内容について、自分でしっかりと理解できるようにもっと勉強したいと思います。
非常に助かりました。心より御礼申し上げます。

回答No.4

real beatin（@realbeatin）

＃１-２です。＃１補足コメント拝見しました。

> うまくいきませんでした。
行高の[自動調整]が出来なかった、ということで宜しいですか？

補足の内容をみて原因となり得る特異点は、ただ一つ、
[結合セル]の行高を[自動調整]しようとしていることです。
Excel本来の仕様として[結合セル]に対しては
[自動調整]は機能しません。
なので、Excelの機能に期待せず、自力実装することになります。
簡単ではないですね。

行の高さを計算で求めるのは、パラメータが多過ぎて困難ですから、
作業列を使って、
作業セル（単セル）の実効幅を結合セルの実行幅（計算で求める）に合わせ、
フォントの各設定を合わせ、値をトレースし、
[折り返して全体を表示する]行高[自動調整]を
作業セルでシミュレートした高さを該当行の高さとして確定します。

何が難しいって、[結合セル]が難しいので、
下に書いたマクロは専ら[結合セル]に対して行の高さをすべて
Excelの[自動調整]仕様に合わせる、というものです。
[結合セル]以外に対しては全く処理しません（＃１-２を参考にして下さい）。

もし、高さを変えたくない[結合セル]があれば、
処理対象セル範囲の指定方法を工夫して除外するようにしてください。

本当は、、、
行高の[自動調整]をしたい[結合セル]が、
何処と何処、、、にあるとかの情報があれば、
もうちょっぴり簡単に書けたかも知れません。

ここに挙げるマクロをお使いのマクロのどのタイミングで実行するか、
ですが、
Sheet1の印刷に関する設定変更等を、ループ中に、
シート毎に処理している場合は、その直前。
'人材番号をA１セルに入力し'た後、
その他、セルやシートの各種設定を、
ループ中に、シート毎に処理している場合は、その後、になります。

以下、こちらの環境では問題なく動いてますが、
もし、何か不足があれば、具体的に書いてくだみてくださいね。
◆でマークしている３か所は、それぞれ引数をそちらで適宜指定（または確認）してください。

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub Re8919629()
Const S = "Sheet1"　'　要指定◆シート名は正確に◆
Dim rWork As Range　'　作業セル範囲
Dim c As Range　'　ループ用の[各セル]
Dim cnCol As Long　'　処理件数

　　If ActiveSheet.Name <> S Then Sheets(S).Select　'　処理対象シートを確実に選択しておく
　　With ActiveSheet.UsedRange　'　処理対象シートの内、使用中の範囲を捉える
　　　　' ' 要指定◆一時的な作業列としてそれより右すべてが使用可能な列を指定（例ではＪ列）◆
　　　　' ' ◆但し、作業列は必ず印刷範囲の外であること◆
　　　　' ' 作業セルを必要な行数に限定した範囲として変数に格納
　　　　Set rWork = Columns("J").Resize(.Rows(.Rows.Count).Row)
　　End With

　　Application.ScreenUpdating = False　'　処理が遅くならないように描画停止
　　On Error GoTo ErrH_　'　エラートラップ
　　' ' 処理対象セル範囲の[各セル]を総当たりでループ
　　cnCol = 0　'　初期化
　　For Each c In Range("E1:E50")　'　要指定◆処理対象セル範囲をRange型で指定◆余裕をもって大きめに指定してもＯＫ
　　　　If c.MergeCells Then　'　[各セル]が結合だったら
　　　　　　If c.Address = c.MergeArea(1).Address Then　'　[各セル]が結合セル範囲の左上だったら
　　　　　　　　If Not c.WrapText Then c.WrapText = True　'　[各セル][折り返して全体を表示する]設定の徹底
　　　　　　　　cnCol = cnCol + 1　'　処理する数をカウント
　　　　　　　　With rWork.Cells(c.Row, cnCol)　'　[各セル]と同じ行　未使用の作業列にあるセルを作業セルとして
　　　　　　　　　　.ColumnWidth = (c.MergeArea.Width * 4 / 3 - 5) / 8　'　作業セルの有効幅を[各セル]に合わせる
　　　　　　　　　　.Font.Name = c.Font.Name　'　作業セルのフォント設定各種を[各セル]に合わせる
　　　　　　　　　　.Font.Size = c.Font.Size
　　　　　　　　　　.Font.Bold = c.Font.Bold
　　　　　　　　　　.Value = c.Value　'　作業セルの値を[各セル]の値を定数化したものに設定
　　　　　　　　　　.WrapText = True　'　作業セルを[折り返して全体を表示する]設定
　　　　　　　　　　.EntireRow.AutoFit　'　作業セルの行高を[自動調整]
　　　　　　　　End With
　　　　　　　　c.RowHeight = c.RowHeight　'　作業セルが規定する行高を確定する
　　　　　　End If
　　　　End If
　　Next
　　rWork.Resize(, cnCol).Clear　'　作業セルをクリア
'　　rWork.Resize(, cnCol).Delete Shift:=xlShiftToLeft　'　作業セルを削除
　　ActiveSheet.UsedRange　'　印刷範囲を変えないようにUsedRange を元に戻す。
ErrH_:
　　If Err Then MsgBox "エラー：" & Err.Number & vbLf & Err.Description　'　エラー時のメッセージ
　　Application.ScreenUpdating = True　'　描画再開
End Sub

補足

ご丁寧なご回答ありがとうございます。なんだかとても難しそうですね…。
横（列）には結合していますが、縦（行）は結合していないので、問題がないと思っていました。

記述頂いたものをコピペして要指定◆の三か所を、
(1)Const S = "プロフィールシート"
(2)Set rWork = Columns("V").Resize(.Rows(.Rows.Count).Row)
(3)For Each c In Range("J13:T13")　'　※試しに結合しているセル範囲J13：T13を入力してみました※
と変えて実行してみましたが、「エラー：1004アプリケーション定義またはオブジェクト定義のエラーです」というメッセージが出ました。

ちなみに、行の高さを自動調整したい結合セルは、F9:T9、F13:T13、F21:T21、F22:T22、F23:T23の５か所です。

印刷ボタンに登録したマクロも念のために記します。
もしよろしければ、またご教授ください。
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Private Sub 印刷開始_Click()
Dim 番号 As Integer
a = TextBox1.Value
n = TextBox2.Value　'プリンタの選択後、印刷またはキャンセル
Dim BlnRtn As Boolean
BlnRtn = Application.Dialogs(xlDialogPrinterSetup).Show
Select Case BlnRtn
Case True
For 番号 = a To n
Sheets("プロフィールシート").Range("A1").Value = 番号
Sheets("プロフィールシート").PrintOut
Next 番号
Case False
MsgBox "印刷はキャンセルされました。"
End Select
Unload Me
End Sub

回答No.3

imogasi

余分なものをそぎ落として、モデル的にテストをやってみた。参考に。
G列に文字データ（被参照データ）入っている。G列各行セルに長短いろいろの文を用意。
それをC列で参照。
すなわちC1に=G1と入れて下方向に式を複写。（VLOOKUPでなく１セル参照に簡略化した）。
ーー
先だって
シートモジュールに
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 Or 7 Then
Columns("3,7").AutoFit
Columns("3,7").WrapText = True
End If
End Sub
を入れた。
いったん入れたG列の文章について、短いセルの文章を長くしたり、短いセルの文章を長くしたりするとC列が反応した。
C列やG列は人間が当初望ましいと思う幅を設定するとする。
この幅は上記VBAでは触らない。

回答No.2

real beatin（@realbeatin）

＃１です。
こちらで書き漏れていたことがあるので追記します。

既に [折り返して全体を表示する]が適用されている場合は、
　　Rows(5).AutoFit　'　５行め　の場合
とか、
　　Rows("5:8").AutoFit　'　５：８行め　の場合
とか、
　　Range("5:5,7:9").EntireRow.AutoFit　'　５行めと７：９行め　の場合
のような行オブジェクトに対する処理も可能ですし、薦める人も多いと思います。。
　　Rows(5).WrapText = True
等の＃１の記述は、
.WrapText = True が設定してあるかどうかを問わずに（再設定かどうかに関係なく）
[折り返して全体を表示する]を設定し行高を調整してくれる記述、ということです。

因みに、これらの記述は、例えば列の幅を狭めた後、にも有効です。

追加補足、以上です。

回答No.1

real beatin（@realbeatin）

こんにちは。

> ...関数を使用しているからか、書式から行の自動調整を設定してみても１行の高さになってしまいます。

[折り返して全体を表示する]ボタンを
数式確定後に再設定すれば
行高の自動調整が適用されます。
（既に設定済の場合は[折り返して全体を表示する]ボタンを２度押す。）
必要なセル範囲、または列等を選択してから
[折り返して全体を表示する]ボタンを押すだけですから、
マクロにするべきかは微妙ですね。
ただ、これは[マクロの記録]機能でも、
必要な記述を得られますので、
まず、[マクロの記録]から始めてみてはいかがでしょう。

部分的な記述だけでしたら、
　　Rows(5).Select　'　５行め　の場合
　　Selection.WrapText = True
とか、
　　Range("5:5,7:9").WrapText = True　'　５行めと７：９行め　の場合
のような記述になります。
数式確定後＝つまり、数式の戻り値（つまり参照元の値）が変わる度に、
その都度、実行してあげる必要があります。

とりあえず、以上です。
まず、ここまでの説明で、出来ることをそちらでやってみてください。
それでも解決しない場合は、具体的にこちらがイメージできるような詳細を
補足欄にでも書いて貰えればお応えします。

補足

ご回答ありがとうございます。
両方試してみましたが、うまくいきませんでした。

詳細を記します。
人材管理データベースからBIツールで名前・性別・資格・自己PRなどの必要な情報項目を抽出して、ExcelのSheet２に人材情報リストとして出力します。（A列が人材番号になっています。）
同じブックのSheet１が作成した定型のプロフィールシートになっており、人材番号をA１セルに入力し、その人材番号をキーにしてSheet2から各情報項目をVLOOKUPで射影しています。プロフィールシートは、列幅は全て同じにしてセルを結合することでレイアウトを整えています。
最後にボタンをプロフィールシートの下部に配置し、印刷用のマクロを登録しました。このマクロはユーザーフォームでFor~NextやPrintoutを使用しただけの簡単なものです。人材番号を入力することで指定の人材範囲のプロフィールシートが連続で印刷出来るようにしてあります。

マクロはあまり関係なさそうですが、宜しくお願いします。