マクロの実行スピードを速くする方法を教えてください
下記のマクロの実行を速くしたいのですが、どのようにしたらいいのか教えていただけないでしょうか。
よろしくお願いいたします。
Sub 列幅指定()
Dim i As Long
Dim t As Long
t = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
i = ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row
Range("A1").RowHeight = 60 '1行目サイズ60
Range("A2:A" & t).RowHeight = 40 '2行目以降 40
Range("A1:AV" & t).WrapText = True '折り返して表示
Range("A1:AV1").VerticalAlignment = xlVAlignCenter '縦位置＝中央揃え
Range("A2:AV" & t).VerticalAlignment = xlVAlignTop '縦位置＝上揃え
'列幅指定
Const W4 As String = "A1,V1"
Const W2 As String = "B1"
Const W3 As String = "C1"
Const W20 As String = "D1,E1,AH1"
Const W10 As String = "F1,K1,L1,P1,Q1,R1,S1,Y1,Z1,AC1,AD1,AE1,AP1,AQ1,AR1,AS1"
Const W8 As String = "G1,I1,J1,M1,T1,X1,AF1,AG1,AM1,AT1,AU1,AV1"
Const W16 As String = "H1,N1,O1,U1,AB1,AH1,AN1,AO1"
Const W6 As String = "W1,AA1"
Const W12 As String = "AJ1,AK1,AL1"
Range(W4).ColumnWidth = 4
Range(W2).ColumnWidth = 2
Range(W3).ColumnWidth = 3
Range(W10).ColumnWidth = 10
Range(W12).ColumnWidth = 12
Range(W20).ColumnWidth = 20
Range(W10).ColumnWidth = 10
Range(W8).ColumnWidth = 8
Range(W16).ColumnWidth = 16
'用紙サイズ設定
ActiveSheet.PageSetup.PaperSize = xlPaperA3
'用紙を縦向きに設定
ActiveSheet.PageSetup.Orientation = xlPortrait
With ActiveSheet.PageSetup
.LeftMargin = Application.CentimetersToPoints(0.8) '左
.RightMargin = Application.CentimetersToPoints(0.5) '右
.TopMargin = Application.CentimetersToPoints(1.6) '上
.BottomMargin = Application.CentimetersToPoints(1.5) '下
.HeaderMargin = Application.CentimetersToPoints(1) 'ヘッダ
.FooterMargin = Application.CentimetersToPoints(0.8) 'フッダ
End With
' 印刷するセル範囲を設定(A1～Ut)
ActiveSheet.PageSetup.PrintArea = Range("A1:U" & t).Address
'印刷の倍率を指定する
ActiveSheet.PageSetup.Zoom = 78
'行タイトルを指定する
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
'罫線を引く
Range("A1:U" & t).Borders.LineStyle = xlContinuous
Range("W1:AV" & t).Borders.LineStyle = xlContinuous
'太線を引く
Range("I1:I" & t).Borders(xlEdgeLeft).Weight = xlMedium
Range("K1:K" & t).Borders(xlEdgeLeft).Weight = xlMedium
Range("R1:R" & t).Borders(xlEdgeLeft).Weight = xlMedium
'ヘッダーフッダー設定
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftHeader = "&""ＭＳ Ｐゴシック,太字""&20【&A】登録状況一覧"
.CenterHeader = ""
.RightHeader = Format(Date, "ggge年m月d日") & "現在" '日付
.LeftFooter = ""
.CenterFooter = "&P/&N"
.RightFooter = ""
End With
'グループ化
Call Columns("G").Group '列のグループ化
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
Call Columns("L:N").Group '列のグループ化
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
Call Columns("Q").Group '列のグループ化
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
'カンマを付ける
Range("I2:J" & t + 1).NumberFormatLocal = "#,###"
End Sub
![その他([技術者向] コンピューター) イメージ](https://gazo.okwave.jp/okwave/spn/images/related_qa/c205_1_thumbnail_img_sm.png)
お礼
m_and_dmpさん、ありがとうございました。 こちらでも、そこだけを抜き出して実行したところ、うまく表示されました。 他の印刷設定が邪魔しているのかもしれないと、最後にもってきたら 希望通りに表示されました。 お手数をおかけして申し訳ありませんでした。 ありがとうございました。