【VBA】複数シートを高速にループする（印刷プレビューやページ設定）コード
明けましておめでとうございます🐄
さて、新年最初のネタは、複数シートをFor Each～でループしながら、
印刷プレビューや印刷範囲を設定する時に実質的に高速に回すことができるコードの紹介です。
ネットを検索すると、定番の
Application.ScreenUpdating = False’画面更新停止
Application.Calculation = xlCalculationManual '手動計算～Application.Calculation = xlCalculationAutomatic '自動計算に戻す
Application.PrintCommunication = False’プリンター通信を遮断
などが挙げられていますが、、、そんなに変わりませんでした。
私が最も効果を実感したのは、
sh.DisplayPageBreaks = False '''''''''''''''''''''★改ページを非表示にする
というコードです。これを入れるとループ速度が飛躍的に向上しました。
コード例）
シートインデックス１シートのＡ２セルに、ページ設定先頭セル入力。Ａ３セルに終端セル入力して、
数字名シートのページ設定、改ページ／標準ビューを切り替えるコードです。
-----------------------------------------------------------------
Sub ★数字シートページ設定プレビュー切り替え基本形()
Dim ash, sh As Worksheet
Set ash = ActiveSheet
For Each sh In Worksheets
If IsNumeric(sh.Name) = True Then '数字シート限定
With sh.PageSetup
'★ページ範囲設定
Dim pa1 As String
Dim pa2 As String
pa1 = Sheets(1).Range("A2").Value 'ページ設定開始セル
pa2 = Sheets(1).Range("A3").Value 'ページ設定終端セル
.PrintArea = Range(pa1, pa2).Address '★セル値で設定
.Zoom = False '１ページに収める
.FitToPagesTall = 1 '１ページに収める
.FitToPagesWide = 1 '１ページに収める
sh.DisplayPageBreaks = False '''''''''★改ページ非表示
End With
'★★プレビュー切替設定
sh.Activate '★shをアクティブにする
If ActiveWindow.View = xlNormalView Then
ActiveWindow.View = xlPageBreakPreview
sh.DisplayPageBreaks = False '''''''''''''★改ページ非表示
ElseIf ActiveWindow.View = xlPageBreakPreview Then
ActiveWindow.View = xlNormalView
sh.DisplayPageBreaks = False '''''''''''''★改ページ非表示
End If
End If
Next
Application.ScreenUpdating = True
ash.Activate
MsgBox "処理完了"
End Sub
-----------------------------------------
表だらけでデータ量の大きいページでも、ループが高速に動くのを実感できると思います。
このような処理の場合、シートを配列に入れて回しても、処理は、1枚ずつ行われるので、改ページ表示の点線の表示を停止すると高速になるようです。
あまり触れられていないので、紹介してみました。
・・・もしかしたら、極秘テクニックなのか・・・
はたまた、そんなの当たり前だよ！ってコードなのか・・・。
とにかく、私が試した中では最も高速に動きました。
では、本年もよろしくお願い申し上げます。
【VBA】データ最終行をFor eachループで取得するマクロ
データ最終行を取得するVBAコードは、
Cells(Rows.Count, 1).End(xlUp).Row
が定番ですが、任意の範囲内なら、For each nextを使って最終行を取得した方が手軽にできそうな気がしてコードを書いてみました。
【使い道】
出席簿備考欄の記述で、「新型コロナウイルス感染拡大予防に伴う処置」など、長文を２行に分割するために、Ｅ列選択セル以下のデータを1行下にずらし値をコピーします。その後、1行目は左半分、２行目には右半分の文字を取り出し表示します。最後に書式をコピーします。
-----------------------------------------
【コード】
Sub 範囲を1行下にコピーして言葉を2分割する()
Dim ac As Range
For Each Rng In Range("E2:E41")
Set ac = ActiveCell
If Rng <> "" Then
Set a = Range(Cells(ac.Row, "A"), Cells(Rng.Row, "H")) 'アクティブセル～データ最終行までの範囲を取得
End If
Next
a.Copy a.Offset(1, 0)
'文字を２分割表示する'切り上げ整数化
le = WorksheetFunction.RoundUp*1.Copy
Range(Cells(ac.Row + 1, "A"), Cells(41, "H")).PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
ac.Select
End Sub
-----------------------------------
備忘録、備忘録
では、また(^^)/
【VBA】出席簿で欠席内訳を備考欄にまとめて記入する（Join関数）
出席簿を自動化する上で、備考欄の記入も自動でできるように検討してきました。
今回は、長欠の内訳を、Join関数を使って記入する方法を紹介します。
授業日数の１／３以上欠席した児童の氏名、理由、合計日数を備考欄に記入するシートを例として作ってみました。
病欠理由のカウントを入力して、左上のボタンを押すと、備考欄に記入されます。
サンプルシートを載せました。興味がある方はダウンロードして遊んでみてください。
---------------------------------------------------
【サンプルシート】
では、また(^^)/
