| 
    
     |  | ▼ichinose さん: 
 ochinoseさん、ありがとうございました!!
 すごいですね 少し改造して無事解決しました!!
 
 「計算でダメならコピーして計ってしまえ」って考えですね 笑
 正確にはフォントサイズなどのコピーを必要でしたが、
 ほぼこのソースでいけました!!新しい発想で楽しかったです。
 
 ありがとうございました!
 
 >▼mog さん:
 >おはようございます。
 >
 >
 >アクティブなシートに対しての例です。
 >
 >このシートの右隣に作業する真っ白なシートを用意してください。
 >
 >標準モジュールに
 >
 >'===================================================
 >Sub test()
 >  Call set_scale(Range("a1")) 'パラメーターに指定したセルが結合セルの
 >'                 先頭せるで実際に高さ調節を行いたいセルです。
 >End Sub
 >'====================================================
 >Sub set_scale(rng As Range, Optional sht As Worksheet = Nothing)
 >  Dim tmprng As Range
 >  On Error Resume Next
 >  Set tmprng = rng.MergeArea
 >  If Err.Number <> 0 Then
 >    Set tmprng = rng
 >    End If
 >  With tmprng
 >    If sht Is Nothing Then
 >     Set sht = .Parent.Next
 >     End If
 >    wk = .ColumnWidth * (.Columns.Count)
 >    sht.Range("a1").ColumnWidth = wk
 >    sht.Range("a1").ColumnWidth = wk + (.Width - sht.Range("a1").Width) * (sht.Range("a1").ColumnWidth) / sht.Range("a1").Width
 >    sht.Range("a1").HorizontalAlignment = .HorizontalAlignment
 >    sht.Range("a1").VerticalAlignment = .VerticalAlignment
 >    sht.Range("a1").WrapText = True
 >    sht.Range("a1").Value = .Value
 >    .RowHeight = sht.Range("a1").RowHeight / .Rows.Count
 >    sht.Range("a1").Clear
 >    End With
 >End Sub
 >
 >簡単な説明で申し訳ないですが、試してみてください。
 >即興作成なので穴はあるかもしれませんが、
 >考え方は、作業シートに
 >結合セルではなく、単一セルで高さ調整を行いたい対象結合セルと
 >同じ列幅に設定し、結合セルの内容をここに流し込みます。
 >単一セルですから、列の高さは自動設定されますから、
 >その高さを元の結合セルに設定するという方法です。
 >
 >試してみてください。
 
 |  |