|
>現状どおり手作業で粘って
...と比較するなら、
"dummy" という名前のシートを用意。
結合セルをActiveにし、下記実行。
ショートカットキーに登録したりすると、ちょっとはラクかも。
Sub try()
Dim r As Range
Dim x As Single
Dim i As Long
Set r = ActiveCell.MergeArea
For i = 1 To r.Columns.Count
x = x + r.Columns(i).ColumnWidth
Next
With Sheets("dummy").Range("A1")
With .Font
.Name = r.Item(1).Font.Name
.Bold = r.Item(1).Font.Bold
.Size = r.Item(1).Font.Size
End With
.WrapText = True
.Value = r.Item(1).Value
.ColumnWidth = x
.EntireRow.AutoFit
r.RowHeight = .RowHeight / r.Rows.Count
End With
Set r = Nothing
End Sub
(フォントによってはうまくいかないケースもあるかも...)
|
|