Sub NiceRowheight()
'余白設定
Const buf = 10
Application.ScreenUpdating = False
'とりあえず選択範囲の行高さをAutoFitする
Selection.Rows.AutoFit
'選択範囲が広すぎる時のために、データ最終行を獲得しておく
maxrow = Range("A1").SpecialCells(xlLastCell).Row
'その後、微妙に行高さを広げる。(1列目のみ処理)
For Each hoge In Selection.Columns(1).Cells
hoge.RowHeight = hoge.RowHeight + buf
'経過観察&終了判定
i = i + 1
If i Mod 2000 = 0 Then
'終了判定(データの最終行を越えてたら終了する。)
If hoge.Row > maxrow Then Exit For
Application.StatusBar = i
DoEvents
End If
Next
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
0 件のコメント:
コメントを投稿