【はじめに】
- エクセルVBAを学び始めて、業務効率化に活かそうと考えているけれど使いたいコードが中々見つからない
- これだと思っても、コードが難しくて自分で作ったコードにどう組み込めばいいか分からない
そこで今回は、私が実際に実務でよく使うコード3選を公開します。
実際にこのコードをいろいろな場面で使い回したことで、1時間の業務が15分まで短縮することができています。
ぜひ参考にしてください。
【実務で即使えるVBAサンプルコード3選】
『複数のファイルをまとめて開く』
資料作成でデータ集計のために、別の資料からデータ等を参照することがあるとしましょう。 その際に次のような課題があります。- 開く資料は毎回同じで複数開くこともある
- 保存先のフォルダはバラバラ
- ファイル内のデータ更新とファイル名の変更も頻繁にある
- ショートカットを作成しても、一つひとつファイルを開くときの待機時間が煩わしい
Sub OpenFile()
'処理にエラーが発生したら「Exception」以降の例外処理へ進む
On Error GoTo Exception
'各ファイルのフォルダパス
Dim FilePath1 As String, FilePath2 As String, FilePath3 As String
FilePath1 = ThisWorkbook.Sheets(1).Range("I8")
FilePath2 = ThisWorkbook.Sheets(1).Range("I9")
FilePath3 = ThisWorkbook.Sheets(1).Range("I10")
'各ファイル名
Dim File1 As String, File2 As String, File3 As String
File1 = ThisWorkbook.Sheets(1).Range("A8")
File2 = ThisWorkbook.Sheets(1).Range("A9")
File3 = ThisWorkbook.Sheets(1).Range("A10")
'各ファイルのフルパス
Dim FileFullPath1 As String, FileFullPath2 As String, FileFullPath3 As String
FileFullPath1 = FilePath1 & "¥" & File1
FileFullPath2 = FilePath2 & "¥" & File2
FileFullPath3 = FilePath3 & "¥" & File3
'開いた各ファイルを変数の格納
Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook
Set Wb1 = Workbooks.Open(FileFullPath1, ReadOnly:=True)
Set Wb2 = Workbooks.Open(FileFullPath2, ReadOnly:=True)
Set Wb3 = Workbooks.Open(FileFullPath3, ReadOnly:=True)
'参照するシート名を変数の格納
Dim ShtName1 As String, ShtName2 As String, ShtName3 As String
ShtName1 = ThisWorkbook.Sheets(1).Range("E8")
ShtName2 = ThisWorkbook.Sheets(1).Range("E9")
ShtName3 = ThisWorkbook.Sheets(1).Range("E10")
'参照するシートを変数の格納
Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
Set Ws1 = Wb1.Sheets(ShtName1)
Set Ws2 = Wb2.Sheets(ShtName2)
Set Ws3 = Wb3.Sheets(ShtName3
MsgBox "ファイルを開きました"
Exit Sub
Exception:
'エラー内容をポップアップ表示
MsgBox Err.Number & vbCrLf & Err.Description
'ファイル名変更などで存在しなければ、ダイアログから最新のファイルを選択
Dim NewFile1 As Variant, NewFile2 As Variant, NewFile3 As Variant
'条件① | FileFullPath1(ファイルパス＆ファイル名)が存在しなかった場合
If Not Dir(FileFullPath1) <> "" Then
NewFile1 = Application.GetOpenFilename("Microsoft Excelブック, *.xls?")
If NewFile1 = False Then
'ダイアログでキャンセルボタンが押された場合は処理を終了
End
End If
ThisWorkbook.Sheets(1).Range("A8") = Dir(NewFile1)
'条件② | FileFullPath2(ファイルパス＆ファイル名)が存在しなかった場合
ElseIf Not Dir(FileFullPath2) <> "" Then
NewFile2 = Application.GetOpenFilename("Microsoft Excelブック, *.xls?")
If NewFile2 = False Then
End
End If
ThisWorkbook.Sheets(1).Range("A9") = Dir(NewFile2)
'条件③ | FileFullPath3(ファイルパス＆ファイル名)が存在しなかった場合
ElseIf Not Dir(FileFullPath3) <> "" Then
NewFile3 = Application.GetOpenFilename("Microsoft Excelブック, *.xls?")
If NewFile3 = False Then
End
End If
ThisWorkbook.Sheets(1).Range("A10") = Dir(NewFile3)
End If
'参照するファイル名に更新してから上書き保存
ThisWorkBook.Save
MsgBox "ファイル名を最新にしました"
End Sub
また、まとめてファイルを閉じることも可能です。
Sub CloseFile()
'処理にエラーが発生したら「Exception」以降の例外処理へ進む
On Error GoTo Exception
'各ファイル名
Dim File1 As String, File2 As String, File3 As String
File1 = ThisWorkbook.Sheets(1).Range("A8")
File2 = ThisWorkbook.Sheets(1).Range("A9")
File3 = ThisWorkbook.Sheets(1).Range("A10")
'各ファイルを閉じる
Application.DisplayAlerts = False
Workbooks(File1).Close
Workbooks(File2).Close
Workbooks(File3).Close
Application.DisplayAlerts = True
Exception:
'エラー内容をポップアップ表示
MsgBox Err.Number & vbCrLf & Err.Description
End Sub
ポイント
- 同じレイアウトのシート用意して、次のコードをそのままコピーすれば即使用できます。
- ファイル数やシート数が増えても、変数をFile4, File5...のように増やして、変数部分を変えてコードを追加していけば問題ありません。
- 変数名は自分がコードを見たときに、何を表しているか分かりやすい名前をつけましょう。
『ダイアログを開いて任意のファイルとシート名を指定して開く』
雛形をもとに提案資料を作成する際に、すでに提案している別資料のデータを引用したい場合を考えましょう。 そこで、提案資料においてデータ参照して入力する処理をVBAで自動化するときに次の課題があるとします。- 引用元も別の雛形を使用しているため、各自のオリジナル資料ではない
- 資料の命名規則は各自によってバラバラ
- 資料内のシート数も名前も異なるため、VBAのコードの中に直接ファイル名やシート名の定義ができない
'ユーザフォームの「CommandButton1」を選択したときに自動でSub~End Subが作成
Sub ボタン1_Click()
UserForm1.Show vbmodeless
End Sub
'------------------------
'プログラム① | ダイアログを表示して開くファイルを選択、ファイル内の各シート名をリストボックスに追加していく
Private Sub UserForm_Initialize()
'①-1 | ダイアログを表示して、開くファイルを選択する
Dim OpenFileName As String
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック, *.xls?")
'ファイル名を選択して「OK」が押される
If OpenFileName <> "False" Then
Workbooks.Open OpenFileName
'「キャンセル」が押される
Else
MsgBox "キャンセルしました"
End If
'①-2 | 開いたファイル内の各シート名をリストボックスに追加する
Dim MyList() As Variant
Dim i As Integer
With UserForm1.ListBox
'一つだけ選択
.MultiSelect = fmMultiSelectSingle
'チェックボックス表示
.ListStyle = fmListStyleOption
ReDim Preserve MyList(ActiveWorkbook.Worksheets.Count)
'シート名を取得
For i = 1 To Sheets.Count
MyList(i) = ActiveWorkbook.Worksheets(i).Name
Next i
'リストボックスに追加
For i To UBound(MyList)
.AddItem MyList(i)
Next i
End With
End Sub
'--------------------------------------
'プログラム② | リストボックスを表示させて、選択したシートを表示（アクティブシートに）する
Private Sub CommandButton1_Click()
'②-1 | 選択したシート名を「ShtName」に代入
Dim ShrName As String
ShtName = UserForm.ListBox1.Value
'選択したシートを表示（アクティブなシート）
Sheets(ShtName).Activate
'ユーザフォームを閉じる
Unload UserForm1
'表示しているシートを「TargetSht」に代入
Dim TargetSht As Worksheet
Set TargetSht = ActiveSheet
'---------ここから先に自分で作成したコードが書いていく
'↓
End Sub
ポイント
- 「ボタン1」や「UserForm1」などについている数字は作成するごとにカウントアップされていくので、すでに別のボタンやUserFormを作成した場合は、「ボタン2」や「UserForm2」のように名前が変わります。
- ユーザフォームで作成したボタンやその他フォーム以外はそのままコピーすれば即使用できます。
『複数シートの印刷設定を一括で行い、プレビュー、印刷、PDF発行する』
ファイル内に複数のシートがあり、ファイル全体を印刷したい場合に次のような場合があるとします。- ファイルの印刷画面で設定したにも関わらず、白黒とカラーが混ざって出力される
- 同様に用紙サイズ、印刷の向きがバラバラ
- 結局、シートごとに再設定した印刷し直さないといけない
'プレビュー
Sub Preview()
'印刷設定の前にプリンターとの通信を遮断（処理の高速化のため）
Application.PrintCommunication = False
'ブック内のシートの印刷設定を順番に繰り返し処理
For Each Sht In ThisWorkbook.Worksheets
Sht.Select
With Sht.PageSetup
.PrintArea = "印刷範囲" '印刷範囲
.Orientation = xlLandscape '用紙の向き
.PaperSize = xlPaperA4 '用紙のサイズ
.LeftMargin = Application.CentimetersToPoints(0.5) '左余白
.RightMargin = Application.CentimetersToPoints(0.5) '右余白
.TopMargin = Application.CentimetersToPoints(0.5) '上余白
.BottomMargin = Application.CentimetersToPoints(0.5) '下余白
.HeaderMargin = Application.CentimetersToPoints(0.5) 'ヘッダー
.FooterMargin = Application.CentimetersToPoints(0.5) 'フッター
.CenterHorizontally = True '水平中央
.CenterVertically = True '垂直中央
.FitToPagesWide = 1 '全ての列を1ページに収める
.FitToPagesTall = 1 '全ての行を1ページに収める
End With
Next Sht
'保存先フォルダパス＆ファイル名（拡張子抜き）
Dim strFile As String
strFile = ThisWorkbook.Path & "¥" & "ファイル名"
'プリンターとの通信を再開
Application.PrintCommunication = True
ActiveWorkbook.PrintOut Preview:= True
End Sub
'----------------------------------
'印刷
Sub PrintOut()
'印刷の前にプリンターとの通信を遮断（処理の高速化のため）
Application.PrintCommunication = False
'保存先フォルダパス＆ファイル名（拡張子抜き）
Dim strFile As String
strFile = ThisWorkbook.Path & "¥" & "ファイル名"
'プリンターとの通信を再開
Application.PrintCommunication = True
'ブック全体を印刷
ThisWorkbook.PrintOut
'印刷するシートを選択したい場合
'ThisWorkbook.Sheets("シート名").PrintOut
'印刷完了をポップアップ表示
MsgBox "印刷完了しました"
End Sub
'----------------------------------
'PDF発行
Sub ExportPDF()
'印刷の前にプリンターとの通信を遮断（処理の高速化のため）
Application.PrintCommunication = False
'保存先フォルダパス＆ファイル名（拡張子抜き）
Dim strFile As String
strFile = ThisWorkbook.Path & "¥" & "ファイル名"
'プリンターとの通信を再開
Application.PrintCommunication = True
'ブック全体をPDF発行
ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile & ".pdf"
'PDF発行するシートを選択したい場合
'ThisWorkbook.Sheets("シート名").ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile & ".pdf"
'PDF発行完了をポップアップ表示
MsgBox "PDF出力完了しました"
End Sub
ポイント
- 印刷設定の値を任意に変更することで、印刷設定を調整することができます。
【さいごに】
今回は、「実務で即使える」VBAサンプルコード3選を紹介しました。特に、ルーティン業務などはVBAで効率化できる可能性が高いです。
最初は自身の業務の中でVBAを使ってみて、効果を実感することが大事だと思います。
コードを公開することで皆さんの参考になれば嬉しいです。