Excel VBAで業務効率化｜中小企業で実際に使ったマクロ事例5選
小西 貴大
「毎月同じ集計作業をExcelで繰り返している。この作業を自動化できないのだろうか」——そう思いながらも、「プログラミングは難しそう」「専任のエンジニアがいないと無理では」と感じて、一歩踏み出せずにいる方は少なくありません。
ExcelにはVBAというプログラミング機能が最初から搭載されており、追加費用もゼロ、特別なソフトも不要で定型作業の自動化を始めることができます。私が中小企業診断士として、複数の中小企業の業務効率化支援でExcel VBAを活用してきた経験から、中小企業の現場で実際に効果が出たVBAマクロの事例を5つ厳選して解説します。
近年では生成AIの登場により、プログラミングのハードルもかなり低くなっています。この記事を読めば「自社のあの作業、VBAで自動化できそうだ」と具体的なイメージが持てるようになると思います。
目次
- 1 Excel VBAとは？マクロとの違いと中小企業で使う理由
- 2 Excel VBAが中小企業に向いている3つの理由
- 3 【事例1】複数シートのデータを1クリックで月次集計レポートに集約する
- 4 【事例2】請求書テンプレートへの自動転記とPDF一括保存
- 5 【事例3】入力フォームからデータ台帳に自動登録する
- 6 【事例4】不要行の自動削除とデータクレンジング
- 7 【事例5】Outlookメールの一括自動作成
- 8 VBAを導入するときの注意点と「引き継ぎ問題」の解決策
- 9 生成AIを使えばVBAコードをゼロから書かなくてよい
- 10 よくある質問（FAQ）
- 11 まとめ：Excel VBAは中小企業の「最初の自動化」に最適
Excel VBAとは？マクロとの違いと中小企業で使う理由
VBAとマクロの違いを1分で理解する
Excel VBAとマクロは混同されがちですが、厳密には別物です。
マクロとは、Excelの操作手順を記録・再生する仕組みそのものを指します。「マクロの記録」機能を使えば、クリックやデータ入力の操作を自動で記録し、ボタン一つで再現できます。
VBA（Visual Basic for Applications）とは、マクロを書くためのプログラミング言語です。マクロの記録では実現できない条件分岐「もし〜なら〜する」や繰り返し処理「100行分を順番に処理する」を自由に記述できます。
実務での使い分けの目安は次のとおりです。
| やりたいこと | 向いている手段 |
|---|---|
| 特定の操作を毎回同じ手順で繰り返す | マクロの記録で十分 |
| 条件によって処理を変えたい | VBAが必要 |
| 複数ファイルを一括処理したい | VBAが必要 |
| ループ・自動判定が含まれる作業 | VBAが必要 |
中小企業の現場で業務効率化の効果が大きいのはVBAを使った処理です。本記事では「広義のマクロ」としてVBAも含めて解説します。
追加費用ゼロ・特別な環境不要で始められる
Excel VBAの最大のメリットは、すでにExcelが入っているPCなら今すぐ始められる点です。
Microsoft 365（旧Office 365）でも、パッケージ版のExcelでも、VBAは標準搭載されており、「開発」タブを有効化するだけで使えるようになります。RPAツールやノーコードツールのように月額費用が発生しないため、効果が出るか分からない段階でのコストゼロでスタートできます。
Excel VBAが中小企業に向いている3つの理由
中小企業がVBAを使う理由は、コスト以外にも3つあります。
- Excelが業務の中心にすでにある
中小企業の業務の多くはExcelで管理されています。集計表・受発注管理・シフト表・売上報告など、Excelを日常的に使っている環境であれば、VBAはその延長線上で使える自動化ツールです。新しいシステムを導入して覚え直す必要がありません。 - IT担当者がいなくても運用できる
VBAを一度作ってしまえば、ボタンを押すだけで誰でも使えます。現場のベテラン社員が手作業でやっていた集計を、新入社員がボタン一つで完了させることができます。メンテナンスのことを考えなければ、IT担当者がいなくても運用ができます。 - 小さな改善から始めやすい
「全社一斉に新システムを導入する」必要はありません。1つの業務・1つのExcelファイルだけを対象にした小さなVBAから始め、効果を確認してから範囲を広げることができます。初期投資ゼロで小さく始められるのは、資金・人員が限られた中小企業にとって大きな利点です。
【事例1】複数シートのデータを1クリックで月次集計レポートに集約する
どんな業務に使えるか
「各店舗・各部門のExcelシートに入力された売上データを、月末に1つのシートにコピーして集計している」——この作業はVBAで完全自動化できます。
私が支援した全国数十カ所に施設を展開する介護施設事業者（従業員約1,100名）では、基幹システムから出力した売上データをExcelに貼り付け、VBAで施設ごとの売上・稼働実績を自動集計する仕組みを構築しました。
これまでは集計担当者が独自に関数（計算式）を作成しており、引き継ぎの度にノウハウが断絶していた結果、後任者が集計表の計算内容を理解できない状態になっていました。
しかし、「①売上データ出力＞②所定のExcelシートへの貼り付け（フォーマット化）＞③VBAの実行（プログラム化）」という簡単な3ステップの業務手順を構築した結果、毎月末に2〜3時間かかっていた集計・分析業務が約10分で完了するようになり、担当者の負担が大幅に解消されました。（支援実績の詳細はこちら）
VBAコードの例
以下は、カフェを3店舗運営している企業を想定した、Excelの売上集計表です。
各店舗とも同じ体裁の売上集計Excelを使用しており、各店舗で商品別の月次集計を行っています。月次集計が終った売上集計Excelは本社に送られ、本社の経理部門が全店の売上集計をまとめるといったイメージです。
本社の経理部門が全店の売上集計をする際に、各店舗の売上集計Excelから自動でデータ取得＆転記するVBAは以下の通りです。
Option Explicit
Sub 全店舗月別集計自動作成()
Const FOLDER_PATH As String = "C:\Users\<ユーザー名>\Desktop\集計フォルダ\"
Dim storeFiles(2) As String
storeFiles(0) = "A店舗.xlsx"
storeFiles(1) = "B店舗.xlsx"
storeFiles(2) = "C店舗.xlsx"
Dim storeStartRow(2) As Integer
storeStartRow(0) = 3
storeStartRow(1) = 9
storeStartRow(2) = 15
Const MONTH_START_COL As Integer = 4
Dim prices(4) As Long
prices(0) = 300
prices(1) = 350
prices(2) = 300
prices(3) = 250
prices(4) = 400
Dim months(11) As String
months(0) = "1月"
months(1) = "2月"
months(2) = "3月"
months(3) = "4月"
months(4) = "5月"
months(5) = "6月"
months(6) = "7月"
months(7) = "8月"
months(8) = "9月"
months(9) = "10月"
months(10) = "11月"
months(11) = "12月"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Dim wsDest As Worksheet
Dim wsFound As Boolean
wsFound = False
Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets
If sh.Name = "月別売上集計" Then
Set wsDest = sh
wsFound = True
Exit For
End If
Next sh
If Not wsFound Then
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
MsgBox "「月別売上集計」シートが見つかりません。", vbCritical, "エラー"
Exit Sub
End If
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim qty As Long
Dim filePath As String
Dim errMsg As String
Dim errCount As Integer
Dim updCount As Integer
errMsg = ""
errCount = 0
updCount = 0
For i = 0 To 2
filePath = FOLDER_PATH & storeFiles(i)
If Dir(filePath) = "" Then
errCount = errCount + 1
errMsg = errMsg & Chr(10) & " ・" & storeFiles(i) & " が見つかりません"
Else
Set wbSrc = Workbooks.Open(Filename:=filePath, ReadOnly:=True, UpdateLinks:=False)
For j = 0 To 11
Set wsSrc = Nothing
On Error Resume Next
Set wsSrc = wbSrc.Sheets(months(j))
On Error GoTo 0
If Not wsSrc Is Nothing Then
Dim destCol As Integer
destCol = MONTH_START_COL + j
For k = 0 To 4
qty = CLng(wsSrc.Cells(k + 3, 3).Value)
wsDest.Cells(storeStartRow(i) + k, destCol).Value = qty * prices(k)
updCount = updCount + 1
Next k
End If
Next j
wbSrc.Close SaveChanges:=False
Set wbSrc = Nothing
End If
Next i
Application.Calculation = xlCalculationAutomatic
wsDest.Calculate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If errCount > 0 Then
MsgBox "集計が完了しましたが、下記ファイルが見つかりませんでした：" & Chr(10) & _
errMsg & Chr(10) & Chr(10) & _
"ファイルが「" & FOLDER_PATH & "」にあるか確認してください。", _
vbExclamation, "集計完了（一部ファイルなし）"
Else
MsgBox "✅ 集計が完了しました！" & Chr(10) & Chr(10) & _
" ・読み込み店舗：A / B / C 店舗（計3店舗）" & Chr(10) & _
" ・集計月 ：1月〜12月（計12ヶ月）" & Chr(10) & _
" ・更新セル数 ：" & updCount & " セル" & Chr(10) & Chr(10) & _
"「月別売上集計」シートを確認してください。", _
vbInformation, "集計完了"
End If
End Sub
Sub フォルダ内ファイル確認()
Const FOLDER_PATH As String = "C:\Users\<ユーザー名>\Desktop\集計フォルダ\"
Dim msg As String
Dim f As String
Dim cnt As Integer
msg = "【" & FOLDER_PATH & "】のExcelファイル一覧：" & Chr(10) & Chr(10)
cnt = 0
f = Dir(FOLDER_PATH & "*.xlsx")
Do While f <> ""
msg = msg & " ・" & f & Chr(10)
cnt = cnt + 1
f = Dir()
Loop
f = Dir(FOLDER_PATH & "*.xlsm")
Do While f <> ""
msg = msg & " ・" & f & "（マクロファイル）" & Chr(10)
cnt = cnt + 1
f = Dir()
Loop
If cnt = 0 Then
msg = msg & " （ファイルが見つかりません）"
End If
MsgBox msg, vbInformation, "フォルダ内ファイル確認"
End Sub当該VBAの便利ポイント
このVBAコードの便利なポイントは以下の通りです。
- ファイルを開かずに自動取得
A/B/C店舗のExcelファイルを手動で開く必要がなく、VBAが自動でExcelファイルを開いて閉じます。ファイルを開きっぱなしにしないので、元データを誤って書き換えるリスクもありません。 - シートが存在しない月はスキップ
例えばC店舗の3月シートがまだ作られていない場合でも、エラーで止まらず残りの処理を続けます。月半ばに途中集計としても活用できます。 - ファイルが見つからないときも止まらない
集計フォルダにB店舗のファイルだけ入っていないケースでも、A・Cは集計して最後にどのファイルが見つからなかったかをまとめて通知します。 - 補助VBAでフォルダ確認ができる
「フォルダ内ファイル確認VBA」を実行すると、集計フォルダに何のExcelファイルが入っているかをダイアログで確認できます。「なぜか集計されない」というときのデバッグに使えます。
導入効果の目安
手作業でコピー＆ペーストを繰り返していた12シート分の集計が、ボタンを押すだけで数秒で完了します。上記のExcelサンプルでは品目が少ないですが、実際には数十から数百の品目を扱っている企業もあるでしょう。その場合、月1回の集計であれば月2〜3時間の削減が見込めます。
【事例2】請求書テンプレートへの自動転記とPDF一括保存
どんな業務に使えるか
「取引先ごとの売上データが一覧表にある。それをもとに毎月、請求書テンプレートに手動で転記してPDF保存している」——経理・営業事務でよく見られる作業です。
取引先が10社なら1時間程度でも、30社・50社になると半日仕事になります。この作業はVBAで一括処理できる典型例です。
VBAコードの例
以下は、取引先6社・10件の受注案件が、売上データ一覧Excelに管理されている状態です。
この売上データ一覧Excelからデータを取得し、取引先企業別に請求書テンプレートExcelへデータを転記、更にPDFの請求書作成までをVBAで自動処理する内容となっています。
Option Explicit
Sub 請求書一括PDF作成()
Const FOLDER As String = "C:\Users\<ユーザー名>\Desktop\集計フォルダ\"
Const DATA_FILE As String = "売上データ一覧.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' ─────────────────────────────────────────────────────
' ① データファイル存在確認
' ─────────────────────────────────────────────────────
If Dir(FOLDER & DATA_FILE) = "" Then
MsgBox DATA_FILE & " が見つかりません。", vbCritical, "エラー"
GoTo Finally
End If
' ─────────────────────────────────────────────────────
' ② データ読み込み（最新シートを自動使用）
' ─────────────────────────────────────────────────────
Dim wbData As Workbook
Dim wsData As Worksheet
Set wbData = Workbooks.Open(FOLDER & DATA_FILE, ReadOnly:=True, UpdateLinks:=False)
Set wsData = wbData.Sheets(wbData.Sheets.Count)
Dim targetMon As String
targetMon = wsData.Name
' ─────────────────────────────────────────────────────
' ③ 発行日・支払期限をシート名から自動計算
' ─────────────────────────────────────────────────────
Dim issueDateStr As String
Dim payDateStr As String
issueDateStr = ""
payDateStr = ""
On Error Resume Next
Dim yr As Integer, mo As Integer
yr = CInt(Left(targetMon, 4))
mo = CInt(Mid(targetMon, 6, InStr(targetMon, "月") - 6))
If yr > 2000 And mo >= 1 And mo <= 12 Then
issueDateStr = Format(DateSerial(yr, mo + 1, 0), "YYYY年M月D日")
payDateStr = Format(DateSerial(yr, mo + 2, 0), "YYYY年M月D日")
End If
On Error GoTo 0
If issueDateStr = "" Then
issueDateStr = Format(Now, "YYYY年M月D日")
payDateStr = Format(DateAdd("m", 1, Now), "YYYY年M月D日")
End If
' ─────────────────────────────────────────────────────
' ④ PDF保存先フォルダを確保（2階層まで自動作成）
' ─────────────────────────────────────────────────────
Dim pdfBase As String
Dim pdfFolder As String
pdfBase = FOLDER & "請求書PDF\"
pdfFolder = pdfBase & targetMon & "\"
If Dir(pdfBase, vbDirectory) = "" Then MkDir pdfBase
If Dir(pdfFolder, vbDirectory) = "" Then MkDir pdfFolder
' ─────────────────────────────────────────────────────
' ⑤ 取引先コードを Collection で収集（上限なし）
' ─────────────────────────────────────────────────────
Dim lastRow As Long
lastRow = wsData.Cells(wsData.Rows.Count, 3).End(xlUp).Row
Dim colCodes As New Collection
Dim r As Long
Dim cd As String
On Error Resume Next
For r = 3 To lastRow
cd = Trim(wsData.Cells(r, 2).Value)
If cd <> "" Then colCodes.Add cd, cd
Next r
On Error GoTo 0
Dim overflowMsg As String
overflowMsg = ""
Dim invoiceNum As Integer
invoiceNum = 1
' ─────────────────────────────────────────────────────
' ⑥ 品目集計用配列（同名品目を合算するため500枠確保）
' ※1取引先あたりの品目種別が500を超えることは実用上ほぼない
' ─────────────────────────────────────────────────────
Const MAX_ITEMS As Integer = 500
Dim ci As Integer
For ci = 1 To colCodes.Count
cd = colCodes(ci)
Dim clientName As String
clientName = ""
For r = 3 To lastRow
If Trim(wsData.Cells(r, 2).Value) = cd Then
clientName = wsData.Cells(r, 3).Value
Exit For
End If
Next r
' ─────────────────────────────────────────────────────
' ⑦ 品目ごとに数量を集計
' 同じ品目名が複数行あれば数量を合算 → 1行に圧縮
' 例）コンサルティング×3件 → コンサルティング 数量3 として1行
' ─────────────────────────────────────────────────────
Dim itemNames(MAX_ITEMS) As String
Dim itemQtys(MAX_ITEMS) As Double
Dim itemPrices(MAX_ITEMS) As Double
Dim uniqueCount As Integer
uniqueCount = 0
Dim rawCount As Integer
rawCount = 0
Dim k As Integer
Dim hinmoku As String
Dim found As Boolean
For r = 3 To lastRow
If Trim(wsData.Cells(r, 2).Value) = cd Then
rawCount = rawCount + 1
hinmoku = Trim(wsData.Cells(r, 4).Value)
found = False
For k = 0 To uniqueCount - 1
If itemNames(k) = hinmoku Then
itemQtys(k) = itemQtys(k) + wsData.Cells(r, 5).Value
found = True
Exit For
End If
Next k
If Not found Then
If uniqueCount < MAX_ITEMS Then
itemNames(uniqueCount) = hinmoku
itemQtys(uniqueCount) = wsData.Cells(r, 5).Value
itemPrices(uniqueCount) = wsData.Cells(r, 6).Value
uniqueCount = uniqueCount + 1
End If
End If
End If
Next r
' ── 請求書シートをコピーして新ブックを作成 ──────────────
ThisWorkbook.Sheets("請求書").Copy
Dim wbTmpl As Workbook
Dim wsTmpl As Worksheet
Set wbTmpl = ActiveWorkbook
Set wsTmpl = wbTmpl.Sheets("請求書")
' ── ヘッダー情報を転記 ──────────────────────────────
wsTmpl.Cells(2, 3).Value = "No. INV-" & Format(Now, "YYYYMM") & "-" & Format(invoiceNum, "000")
wsTmpl.Cells(3, 6).Value = issueDateStr
wsTmpl.Cells(5, 2).Value = clientName & " 御中"
wsTmpl.Cells(6, 3).Value = targetMon & "分 業務支援サービス費"
wsTmpl.Cells(7, 3).Value = payDateStr
' ── 明細行を初期化 ──────────────────────────────────
Dim itemRow As Integer
For itemRow = 14 To 19
wsTmpl.Cells(itemRow, 2).Value = ""
wsTmpl.Cells(itemRow, 5).Value = ""
wsTmpl.Cells(itemRow, 6).Value = ""
wsTmpl.Cells(itemRow, 7).Value = ""
Next itemRow
' ── 集計済み品目を転記（最大6行）────────────────────────
' 集計後も7品目以上ある場合は先頭6品目のみ出力し警告
Dim writeRows As Integer
writeRows = uniqueCount
If writeRows > 6 Then writeRows = 6
For k = 0 To writeRows - 1
itemRow = 14 + k
wsTmpl.Cells(itemRow, 2).Value = itemNames(k)
wsTmpl.Cells(itemRow, 5).Value = itemQtys(k)
wsTmpl.Cells(itemRow, 6).Value = itemPrices(k)
wsTmpl.Cells(itemRow, 7).Value = "=E" & itemRow & "*F" & itemRow
Next k
If uniqueCount > 6 Then
overflowMsg = overflowMsg & " ・" & clientName & _
"（元データ " & rawCount & "件 → 集計後 " & uniqueCount & _
"品目 → 先頭6品目のみ出力）" & Chr(10)
End If
' ── ページ設定 ──────────────────────────────────────
With wsTmpl.PageSetup
.PaperSize = xlPaperA4
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintArea = "$A$1:$I$27"
.LeftMargin = Application.CentimetersToPoints(1.5)
.RightMargin = Application.CentimetersToPoints(1.5)
.TopMargin = Application.CentimetersToPoints(1.5)
.BottomMargin = Application.CentimetersToPoints(1.5)
End With
' ─────────────────────────────────────────────────────
' ⑧ ファイル名の無効文字を「_」に置換
' ─────────────────────────────────────────────────────
Dim safeName As String
safeName = clientName
Dim invalidChars As Variant
invalidChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
Dim ch As Variant
For Each ch In invalidChars
safeName = Join(Split(safeName, CStr(ch)), "_")
Next ch
' ─────────────────────────────────────────────────────
' ⑨ 同名PDFが既存の場合はタイムスタンプを付加
' ─────────────────────────────────────────────────────
Dim pdfPath As String
pdfPath = pdfFolder & "請求書_" & safeName & "_" & targetMon & ".pdf"
If Dir(pdfPath) <> "" Then
pdfPath = pdfFolder & "請求書_" & safeName & "_" & targetMon & _
"_" & Format(Now, "HHMMSS") & ".pdf"
End If
' ─────────────────────────────────────────────────────
' ⑩ PDF出力（エラー時は当該社のみスキップして後続を継続）
' ─────────────────────────────────────────────────────
On Error Resume Next
wsTmpl.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=pdfPath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Dim exportErr As String
exportErr = ""
If Err.Number <> 0 Then exportErr = Err.Description
Err.Clear
On Error GoTo 0
wbTmpl.Close SaveChanges:=False
Set wsTmpl = Nothing
Set wbTmpl = Nothing
If exportErr <> "" Then
overflowMsg = overflowMsg & " ・" & clientName & _
"（PDF出力エラー：" & exportErr & "）" & Chr(10)
End If
invoiceNum = invoiceNum + 1
Next ci
wbData.Close SaveChanges:=False
Finally:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If invoiceNum > 1 Then
Dim msg As String
msg = "✅ 完了しました！" & Chr(10) & Chr(10) & _
" ・対象月 ：" & targetMon & Chr(10) & _
" ・発行日 ：" & issueDateStr & Chr(10) & _
" ・支払期限 ：" & payDateStr & Chr(10) & _
" ・作成件数 ：" & (invoiceNum - 1) & " 社分" & Chr(10) & _
" ・保存先 ：" & pdfFolder
If overflowMsg <> "" Then
msg = msg & Chr(10) & Chr(10) & _
"⚠️ 要確認：" & Chr(10) & overflowMsg
End If
MsgBox msg, vbInformation, "請求書PDF作成完了"
End If
End Sub当該VBAの便利ポイント
このVBAコードの便利なポイントは以下の通りです。
- 毎月ほぼ操作ゼロで動く
売上データ一覧に新しい月のシートを追加するだけで、VBAを実行すればあとは全自動。対象月・発行日・支払期限・保存先サブフォルダがすべてシート名から自動で決まるため、毎月コードを書き換える必要がありません。 - 取引先の増減に自動対応
取引先が増えても減っても、売上データ一覧の内容をそのまま反映します。「新しい取引先を追加したからVBAも修正しよう」という作業は一切不要です。 - 何十件の明細も1クリックで整理
同じ品目名の案件が月内に何件あっても、自動で集計して1行に圧縮します。例えば「コンサルティング」が15件あれば「コンサルティング × 15」として1行にまとめ、すっきりした請求書に仕上がります。 - PDFが月別フォルダに自動整理される
請求書PDF\2026年3月 売上一覧\のように月ごとのサブフォルダが自動作成されるため、年々PDFが増えても探しやすい状態が保たれます。
導入効果の目安
1件あたりの手作業による処理時間を約10分と想定した場合、20社分をこなすと月に約3時間20分かかります。VBAを導入すると同じ作業が約2分で完了するため、毎月約3時間18分、年間では約40時間の削減になります。
【事例3】入力フォームからデータ台帳に自動登録する
どんな業務に使えるか
「問い合わせを受けるたびに管理台帳のExcelを開いて最終行を探し、問い合わせ内容を手入力している」——担当者ごとに入力フォーマットがばらついたり、誰かが誤って他の人の行を上書きしてしまったりと、件数が増えるほどミスと管理コストが積み重なっていく業務です。
入力フォームと台帳を分けてボタン一つで登録できる仕組みを作れば、フォーマットのばらつきも行ずれも根本から解消できます。
顧客からの問い合わせ対応記録、受発注の記録管理、設備点検・日報の記録、備品の貸し出し管理など、「誰が・いつ・何を・どう対応したか」を継続的に積み上げていく業務であれば、以下と似たVBAで効率的な管理・運用が行えます。
VBAコードの例
以下は、顧客からの問い合わせ内容を、問い合わせ管理Excelで一括管理している状態です。
入力フォームに必要情報を入力し、「台帳に登録する」ボタンを押すとVBAが実行され、問い合わせ台帳のシートに自動反映されます。
Option Explicit
Sub 台帳に登録する()
' ═══════════════════════════════════════════════════════════════
' 【設定エリア】レイアウトを変更した場合はここだけ修正してください
' ═══════════════════════════════════════════════════════════════
' ── フォームシートの入力行番号（行を追加・移動した場合に変更）
Const ROW_DATE As Integer = 3 ' 問い合わせ日
Const ROW_CLIENT As Integer = 4 ' 顧客名 ※必須
Const ROW_CONTACT As Integer = 5 ' 連絡先
Const ROW_CONTENT As Integer = 6 ' 問い合わせ内容 ※必須（結合セル）
Const ROW_STAFF As Integer = 8 ' 担当者 ※必須
Const ROW_STATUS As Integer = 9 ' 対応状況
Const INPUT_COL As String = "C" ' 入力値が入る列
' ── 台帳シートの列番号（列を追加・移動した場合に変更）
Const COL_NO As Integer = 1 ' No.
Const COL_REG_DT As Integer = 2 ' 登録日時
Const COL_DATE As Integer = 3 ' 問い合わせ日
Const COL_CLIENT As Integer = 4 ' 顧客名
Const COL_CONTACT As Integer = 5 ' 連絡先
Const COL_CONTENT As Integer = 6 ' 問い合わせ内容
Const COL_STAFF As Integer = 7 ' 担当者
Const COL_STATUS As Integer = 8 ' 対応状況
' ── シート名（名前を変更した場合に修正）
Const SHEET_FORM As String = "入力フォーム"
Const SHEET_LEDGER As String = "問い合わせ台帳"
' ═══════════════════════════════════════════════════════════════
' ─────────────────────────────────────────────────────
' ① ファイルが読み取り専用でないか確認
' ─────────────────────────────────────────────────────
If ThisWorkbook.ReadOnly Then
MsgBox "このファイルは読み取り専用で開かれています。" & Chr(10) & _
"書き込みができないため登録を中止します。" & Chr(10) & Chr(10) & _
"別の場所にコピーしてから開き直してください。", _
vbCritical, "読み取り専用エラー"
Exit Sub
End If
' ─────────────────────────────────────────────────────
' ② シートの存在確認
' ─────────────────────────────────────────────────────
Dim wsForm As Worksheet
Dim wsLedger As Worksheet
On Error Resume Next
Set wsForm = ThisWorkbook.Sheets(SHEET_FORM)
Set wsLedger = ThisWorkbook.Sheets(SHEET_LEDGER)
On Error GoTo 0
If wsForm Is Nothing Then
MsgBox "「" & SHEET_FORM & "」シートが見つかりません。" & Chr(10) & _
"シート名が変更されていないか確認してください。", vbCritical, "シートエラー"
Exit Sub
End If
If wsLedger Is Nothing Then
MsgBox "「" & SHEET_LEDGER & "」シートが見つかりません。" & Chr(10) & _
"シート名が変更されていないか確認してください。", vbCritical, "シートエラー"
Exit Sub
End If
' ─────────────────────────────────────────────────────
' ③ 台帳シートの保護確認
' ─────────────────────────────────────────────────────
If wsLedger.ProtectContents Then
MsgBox "「" & SHEET_LEDGER & "」シートに保護がかかっています。" & Chr(10) & _
"シートの保護を解除してから再実行してください。", vbCritical, "シート保護エラー"
Exit Sub
End If
' ─────────────────────────────────────────────────────
' ④ フォームから入力値を取得
' ─────────────────────────────────────────────────────
Dim inquiryDate As String
Dim clientName As String
Dim contact As String
Dim content As String
Dim staffName As String
Dim status As String
inquiryDate = Trim(CStr(wsForm.Range(INPUT_COL & ROW_DATE).Value))
clientName = Trim(CStr(wsForm.Range(INPUT_COL & ROW_CLIENT).Value))
contact = Trim(CStr(wsForm.Range(INPUT_COL & ROW_CONTACT).Value))
content = Trim(CStr(wsForm.Range(INPUT_COL & ROW_CONTENT).Value))
staffName = Trim(CStr(wsForm.Range(INPUT_COL & ROW_STAFF).Value))
status = Trim(CStr(wsForm.Range(INPUT_COL & ROW_STATUS).Value))
' ─────────────────────────────────────────────────────
' ⑤ 必須項目チェック（空欄の場合は登録せず警告）
' ─────────────────────────────────────────────────────
Dim errMsg As String
errMsg = ""
If clientName = "" Then errMsg = errMsg & " ・顧客名" & Chr(10)
If content = "" Then errMsg = errMsg & " ・問い合わせ内容" & Chr(10)
If staffName = "" Then errMsg = errMsg & " ・担当者" & Chr(10)
If errMsg <> "" Then
MsgBox "以下の必須項目を入力してください。" & Chr(10) & Chr(10) & errMsg, _
vbExclamation, "入力エラー"
Exit Sub
End If
' ─────────────────────────────────────────────────────
' ⑥ 問い合わせ日の形式を検証（入力がある場合のみチェック）
' ─────────────────────────────────────────────────────
If inquiryDate <> "" And Not IsDate(inquiryDate) Then
MsgBox "「問い合わせ日」の形式が正しくありません。" & Chr(10) & Chr(10) & _
"入力値：" & inquiryDate & Chr(10) & _
"正しい例：2026/04/07", vbExclamation, "入力エラー"
Exit Sub
End If
' ─────────────────────────────────────────────────────
' ⑦ 対応状況の値を検証（ドロップダウン外の直接入力を防止）
' ─────────────────────────────────────────────────────
If status <> "" And status <> "未対応" And _
status <> "対応中" And status <> "完了" Then
MsgBox "「対応状況」に無効な値が入力されています。" & Chr(10) & Chr(10) & _
"入力値：" & status & Chr(10) & _
"「未対応」「対応中」「完了」のいずれかを選択してください。", _
vbExclamation, "入力エラー"
Exit Sub
End If
' ─────────────────────────────────────────────────────
' ⑧ 省略項目のデフォルト値を設定
' ─────────────────────────────────────────────────────
If status = "" Then status = "未対応"
If inquiryDate = "" Then inquiryDate = Format(Now, "YYYY/MM/DD")
' ─────────────────────────────────────────────────────
' ⑨ 台帳の最終行を自動検出して次の書き込み行を決定
' ─────────────────────────────────────────────────────
Dim lastRow As Long
lastRow = wsLedger.Cells(wsLedger.Rows.Count, COL_NO).End(xlUp).Row
Dim newRow As Long
newRow = lastRow + 1
' ─────────────────────────────────────────────────────
' ⑩ No. を自動採番（最後の値が数値でない場合も安全に処理）
' ─────────────────────────────────────────────────────
Dim newNo As Long
If lastRow >= 3 And IsNumeric(wsLedger.Cells(lastRow, COL_NO).Value) Then
newNo = CLng(wsLedger.Cells(lastRow, COL_NO).Value) + 1
Else
newNo = 1
End If
' ─────────────────────────────────────────────────────
' ⑪ 台帳への書き込み（エラー時はハンドラへジャンプ）
' ─────────────────────────────────────────────────────
On Error GoTo WriteError
With wsLedger
.Cells(newRow, COL_NO).Value = newNo
.Cells(newRow, COL_REG_DT).Value = Format(Now, "YYYY/MM/DD HH:MM")
.Cells(newRow, COL_DATE).Value = inquiryDate
.Cells(newRow, COL_CLIENT).Value = clientName
.Cells(newRow, COL_CONTACT).Value = contact
.Cells(newRow, COL_CONTENT).Value = content
.Cells(newRow, COL_STAFF).Value = staffName
.Cells(newRow, COL_STATUS).Value = status
End With
On Error GoTo 0
' ─────────────────────────────────────────────────────
' ⑫ フォームをリセット（設定エリアのConst参照で統一）
' ─────────────────────────────────────────────────────
wsForm.Range(INPUT_COL & ROW_DATE).Value = ""
wsForm.Range(INPUT_COL & ROW_CLIENT).Value = ""
wsForm.Range(INPUT_COL & ROW_CONTACT).Value = ""
wsForm.Range(INPUT_COL & ROW_CONTENT).Value = ""
wsForm.Range(INPUT_COL & ROW_STAFF).Value = ""
wsForm.Range(INPUT_COL & ROW_STATUS).Value = ""
' ─────────────────────────────────────────────────────
' ⑬ 完了メッセージ
' ─────────────────────────────────────────────────────
MsgBox "✅ 登録しました！" & Chr(10) & Chr(10) & _
" ・No. ：" & newNo & Chr(10) & _
" ・顧客名 ：" & clientName & Chr(10) & _
" ・担当者 ：" & staffName & Chr(10) & _
" ・対応状況：" & status, _
vbInformation, "登録完了"
wsForm.Activate
wsForm.Range(INPUT_COL & ROW_DATE).Select
Exit Sub
' ─────────────────────────────────────────────────────
' エラーハンドラ：書き込み中の予期せぬエラーをキャッチ
' ─────────────────────────────────────────────────────
WriteError:
MsgBox "台帳への書き込み中にエラーが発生しました。" & Chr(10) & Chr(10) & _
"エラー内容：" & Err.Description & Chr(10) & Chr(10) & _
"以下をご確認ください：" & Chr(10) & _
" ・台帳シートに保護がかかっていないか" & Chr(10) & _
" ・ファイルが読み取り専用になっていないか" & Chr(10) & _
" ・ネットワークドライブが切断されていないか", _
vbCritical, "書き込みエラー"
On Error GoTo 0
End Sub当該VBAの便利ポイント
このVBAコードの便利なポイントは以下の通りです。
- 入力ミスを仕組みで防げる
必須項目の空欄・日付の形式エラー・ドロップダウン外の値を、登録ボタンを押した瞬間に自動でチェックします。注意力や経験に関係なく、誰が使っても同じ品質のデータが台帳に蓄積されます。 - 面倒な手作業がゼロになる
台帳の最終行を探す・No.を数えて入力する・登録日時を手書きする、といった毎回発生する小さな手間がすべて自動化されます。登録後はフォームも自動でリセットされるため、次の入力をすぐ始められます。 - 将来の変更に耐えられる設計
フォームに入力項目を追加しても、コード冒頭の設定エリアの数字を1つ変えるだけで対応できます。「前任者が作ったVBAが壊れたが誰も直せない」という属人化の問題も起きにくい構造です。
導入効果の目安
1件あたりの手動入力に約5分かかるとすると、1日10件で約50分が記録作業に消えます。VBAフォームなら1件約1分に短縮され、同じ10件で約10分、月換算で約13時間の削減になります。さらに入力ミスや書き間違いによる手戻りがゼロになるため、実質的な時間削減効果はさらに大きくなります。
【事例4】不要行の自動削除とデータクレンジング
どんな業務に使えるか
「システムから出力したデータに空白行や不要なヘッダー行が混ざっていて、毎回手作業で削除している」——基幹システムからExcelにデータを出力する際によく発生する問題です。
数百〜数千行のデータから特定の条件に合致する行を削除する作業は、手作業では時間がかかりミスも起きやすいですが、VBAなら一瞬で処理できます。
VBAコードの例
以下は、基幹システムから売上データを複数回出力し、Excelに貼り付けた状態です。
データクレンジング前は、データの入っていない空白行・システム出力した際の出力ログ・項目名（列ヘッダー）の行が重複している状態ですが、データクレンジングのVBAを実行することで、自動で削除処理が行われます。
Option Explicit
Sub データクレンジング()
' ═══════════════════════════════════════════════════════════════
' 【設定エリア】システムや出力形式が変わった場合はここだけ修正
' ═══════════════════════════════════════════════════════════════
' ── 処理対象シート名
Const TARGET_SHEET As String = "システム出力データ"
' ── バックアップシート名（実行のたびに上書き更新）
Const BACKUP_SHEET As String = "バックアップ"
' ── 削除判定に使う列
Const KEY_COL As String = "A"
' ── Union の分割閾値（大量データ対策：この件数ごとに一括削除）
Const BATCH_SIZE As Integer = 500
' ── 前方一致で削除する文字列（システムヘッダー・フッターなど）
Dim prefixDelete As Variant
prefixDelete = Array("■", "***")
' ── 完全一致で削除する文字列（空白行など）
' ※ 列ヘッダー行（"No."）は自動検出して先頭の1行だけ残す
Dim exactDelete As Variant
exactDelete = Array("")
' ═══════════════════════════════════════════════════════════════
' ─────────────────────────────────────────────────────
' ① 読み取り専用チェック
' ─────────────────────────────────────────────────────
If ThisWorkbook.ReadOnly Then
MsgBox "このファイルは読み取り専用です。" & Chr(10) & _
"別の場所にコピーして開き直してください。", vbCritical, "読み取り専用エラー"
Exit Sub
End If
' ─────────────────────────────────────────────────────
' ② 対象シートの存在確認
' ─────────────────────────────────────────────────────
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(TARGET_SHEET)
On Error GoTo 0
If ws Is Nothing Then
MsgBox "「" & TARGET_SHEET & "」シートが見つかりません。" & Chr(10) & _
"シート名が変更されていないか確認してください。", vbCritical, "シートエラー"
Exit Sub
End If
' ─────────────────────────────────────────────────────
' ③ シート保護チェック
' ─────────────────────────────────────────────────────
If ws.ProtectContents Then
MsgBox "「" & TARGET_SHEET & "」シートに保護がかかっています。" & Chr(10) & _
"保護を解除してから再実行してください。", vbCritical, "シート保護エラー"
Exit Sub
End If
' ─────────────────────────────────────────────────────
' ④ データ存在確認
' ─────────────────────────────────────────────────────
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, KEY_COL).End(xlUp).Row
If lastRow < 1 Then
MsgBox "処理対象のデータがありません。", vbInformation, "確認"
Exit Sub
End If
' ─────────────────────────────────────────────────────
' ⑤ 実行前の確認ダイアログ
' （VBAによる行削除はCtrl+Zで元に戻せないため必須）
' ─────────────────────────────────────────────────────
Dim ans As Integer
ans = MsgBox("「" & TARGET_SHEET & "」シートのデータを整形します。" & Chr(10) & Chr(10) & _
"処理前に「" & BACKUP_SHEET & "」シートへ自動バックアップします。" & Chr(10) & _
"続行しますか？", vbYesNo + vbQuestion, "実行確認")
If ans = vbNo Then Exit Sub
' ─────────────────────────────────────────────────────
' ⑥ Application の設定を保存してから変更
' （エラー時に確実に元に戻すため、保存はハンドラ設定前に実施）
' ─────────────────────────────────────────────────────
Dim origCalc As XlCalculation
origCalc = Application.Calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
On Error GoTo CleanUp
' ─────────────────────────────────────────────────────
' ⑦ バックアップ作成
' 既存バックアップを削除してから再作成
' Before:=ws で処理シートの左隣に配置し、誤操作を防ぐ
' ─────────────────────────────────────────────────────
On Error Resume Next
ThisWorkbook.Sheets(BACKUP_SHEET).Delete
On Error GoTo CleanUp
ws.Copy Before:=ws
ActiveSheet.Name = BACKUP_SHEET
ws.Activate
' ─────────────────────────────────────────────────────
' ⑧ 事前スキャン：最初に出現する列ヘッダー行（"No."行）を特定
' 先頭の1行のみ正規の列ヘッダーとして保護し、それ以降は削除対象
' ─────────────────────────────────────────────────────
Dim headerRowNum As Long
Dim j As Long
headerRowNum = 0
For j = 1 To lastRow
If Trim(CStr(ws.Cells(j, KEY_COL).Value)) = "No." Then
headerRowNum = j
Exit For
End If
Next j
' ─────────────────────────────────────────────────────
' ⑨ 削除対象行を収集（BATCH_SIZE件ごとに一括削除）
' ・行1から処理してシステムヘッダー行も削除対象に含める
' ・Union の上限を超えないよう分割処理
' ─────────────────────────────────────────────────────
Dim deleteRange As Range
Dim batchCount As Integer
Dim totalDeleted As Long
Dim i As Long
Dim k As Integer
Dim cellVal As String
Dim shouldDelete As Boolean
batchCount = 0
totalDeleted = 0
For i = lastRow To 1 Step -1
' 正規の列ヘッダー行は無条件で保護（削除しない）
If i = headerRowNum Then GoTo ContinueLoop
cellVal = Trim(CStr(ws.Cells(i, KEY_COL).Value))
shouldDelete = False
' 列ヘッダーの繰り返し行（2回目以降の "No." 行）は削除
If cellVal = "No." Then
shouldDelete = True
GoTo AddToDelete
End If
' 完全一致チェック
For k = 0 To UBound(exactDelete)
If cellVal = CStr(exactDelete(k)) Then
shouldDelete = True
Exit For
End If
Next k
' 前方一致チェック
If Not shouldDelete Then
For k = 0 To UBound(prefixDelete)
If Left(cellVal, Len(CStr(prefixDelete(k)))) = CStr(prefixDelete(k)) Then
shouldDelete = True
Exit For
End If
Next k
End If
AddToDelete:
If shouldDelete Then
If deleteRange Is Nothing Then
Set deleteRange = ws.Rows(i)
Else
Set deleteRange = Union(deleteRange, ws.Rows(i))
End If
batchCount = batchCount + 1
' BATCH_SIZE に達したら一括削除してリセット
If batchCount >= BATCH_SIZE Then
totalDeleted = totalDeleted + batchCount
deleteRange.Delete Shift:=xlUp
Set deleteRange = Nothing
batchCount = 0
' 削除後は最終行を再取得
lastRow = ws.Cells(ws.Rows.Count, KEY_COL).End(xlUp).Row
End If
End If
ContinueLoop:
Next i
' 残った分を一括削除
If Not deleteRange Is Nothing Then
totalDeleted = totalDeleted + batchCount
deleteRange.Delete Shift:=xlUp
Set deleteRange = Nothing
End If
' ─────────────────────────────────────────────────────
' ⑩ 設定を元に戻してカーソルをリセット
' ─────────────────────────────────────────────────────
Application.Calculation = origCalc
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ws.Activate
ws.Range("A1").Select
' ─────────────────────────────────────────────────────
' ⑪ 完了メッセージ
' 削除0件の場合はバックアップシートも自動削除
' ─────────────────────────────────────────────────────
Dim remaining As Long
remaining = ws.Cells(ws.Rows.Count, KEY_COL).End(xlUp).Row - 1
If totalDeleted = 0 Then
Application.DisplayAlerts = False
ThisWorkbook.Sheets(BACKUP_SHEET).Delete
Application.DisplayAlerts = True
MsgBox "削除対象の行は見つかりませんでした。" & Chr(10) & _
"すでにクレンジング済みの可能性があります。", vbInformation, "処理結果"
Else
MsgBox "✅ クレンジングが完了しました！" & Chr(10) & Chr(10) & _
" ・削除した行数 ：" & totalDeleted & " 行" & Chr(10) & _
" ・残ったデータ ：" & remaining & " 行" & Chr(10) & Chr(10) & _
"元データは「" & BACKUP_SHEET & "」シートに保存されています。", _
vbInformation, "クレンジング完了"
End If
Exit Sub
' ─────────────────────────────────────────────────────
' エラーハンドラ：中断時も設定を確実に元に戻す
' ─────────────────────────────────────────────────────
CleanUp:
Application.Calculation = origCalc
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "処理中にエラーが発生しました。" & Chr(10) & Chr(10) & _
"エラー内容：" & Err.Description & Chr(10) & Chr(10) & _
"「" & BACKUP_SHEET & "」シートから元データを確認してください。", _
vbCritical, "エラー"
End Sub当該VBAの便利ポイント
このVBAコードの便利なポイントは以下の通りです。
- ボタン1つで不要行を全自動削除できる
手作業では空白行・ヘッダー行・フッター行を目視で探して1行ずつ削除する必要があります。VBAはボタンを押すだけで削除条件に一致する行をすべて自動検出し、数秒で処理が完了します。 - 件数が増えても処理時間がほぼ変わらない
手作業では行数が増えるほど時間とミスが比例して増えます。VBAなら100行でも1万行でも操作は変わらず、月ごとにデータ量が増えても余分な工数が発生しません。 - 誤操作しても元データに戻せる
VBAによる行削除はCtrl+Zで元に戻せません。そのため実行前に元データをバックアップシートへ自動コピーします。万が一余分な行を削除してしまっても、バックアップから即座に復元できます。 - 削除条件の変更が1箇所だけで完結する
システムが変わってヘッダーの表記が変わっても、冒頭の設定エリアの配列に文字列を追記するだけで対応できます。コードの中を探し回って複数箇所を直す必要がありません。 - 担当者が変わっても同じ品質で処理できる
手作業では担当者の経験や注意力によって処理品質がばらつきます。VBAは毎回同じ条件で処理するため、誰が実行しても結果が一定です。引き継ぎ後もそのまま使い続けられます。
導入効果の目安
数百行のデータから不要行を手作業で削除すると20〜30分かかる作業が、ボタン1つで数秒に短縮されます。月次で繰り返す業務であれば、年間で数時間分の削減効果が期待できるでしょう。また、削除し忘れや誤って必要な行を消してしまうミスがゼロになるため、データの修正対応にかかる手戻りの工数も合わせて削減できます。
【事例5】Outlookメールの一括自動作成
どんな業務に使えるか
「毎月、顧客リストに対して個別の数値（請求金額・納品件数など）を記載したメールを送っている。送信先の顧客企業の件数が多くて毎回1〜2時間かかる」——営業・経理部門でよく聞く悩みです。
Excel VBAはOutlookと連携できるため、Excelのリストから宛先・件名・本文を自動生成して一括送信することができます。
VBAコードの例
以下は、月末に顧客企業へ請求金額を連絡する場合に、企業ごとに個別で送信するメールを自動生成するVBAです。
取引先名・メールアドレス・請求金額を取得して、所定の文面を自動生成することで、人間は内容を確認して送信ボタンを押すだけの業務に効率化できます。
Option Explicit
Sub 一括メール送信()
' ═══════════════════════════════════════════════════════════════
' 【設定エリア】送信内容やレイアウトを変更する場合はここだけ修正
' ═══════════════════════════════════════════════════════════════
Const SHEET_NAME As String = "送信リスト"
Const COL_NO As Integer = 1
Const COL_NAME As Integer = 2
Const COL_EMAIL As Integer = 3
Const COL_AMOUNT As Integer = 4
Const COL_MONTH As Integer = 5
Const COL_FLAG As Integer = 6
Const SENDER_NAME As String = "株式会社〇〇 経理部"
' True = 自動送信（本番運用）
' False = 下書きとして開く（内容確認用・推奨）
Const AUTO_SEND As Boolean = False
' ═══════════════════════════════════════════════════════════════
If ThisWorkbook.ReadOnly Then
MsgBox "このファイルは読み取り専用です。", vbCritical, "エラー"
Exit Sub
End If
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(SHEET_NAME)
On Error GoTo 0
If ws Is Nothing Then
MsgBox "「" & SHEET_NAME & "」シートが見つかりません。", vbCritical, "シートエラー"
Exit Sub
End If
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, COL_EMAIL).End(xlUp).Row
If lastRow < 3 Then
MsgBox "送信対象のデータがありません。", vbInformation, "確認"
Exit Sub
End If
' ─────────────────────────────────────────────────────
' ① 送信対象をカウント（未送信・メアド有・取引先名有 のみ）
' ─────────────────────────────────────────────────────
Dim targetCount As Long
Dim r As Long
targetCount = 0
For r = 3 To lastRow
Dim email As String
Dim name As String
Dim flag As String
email = Trim(CStr(ws.Cells(r, COL_EMAIL).Value))
name = Trim(CStr(ws.Cells(r, COL_NAME).Value))
flag = Trim(CStr(ws.Cells(r, COL_FLAG).Value))
If email <> "" And name <> "" And flag <> "送信済み" Then
targetCount = targetCount + 1
End If
Next r
If targetCount = 0 Then
MsgBox "送信対象がありません。" & Chr(10) & _
"すでに全件送信済みか、メールアドレス・取引先名が未入力の行のみです。", _
vbInformation, "確認"
Exit Sub
End If
' ─────────────────────────────────────────────────────
' ② 実行前確認ダイアログ
' ─────────────────────────────────────────────────────
Dim modeLabel As String
modeLabel = IIf(AUTO_SEND, "自動送信", "下書きとして開く（確認用）")
Dim ans As Integer
ans = MsgBox("メールを送信します。" & Chr(10) & Chr(10) & _
" ・送信対象 ：" & targetCount & " 社" & Chr(10) & _
" ・送信モード：" & modeLabel & Chr(10) & Chr(10) & _
"続行しますか？", vbYesNo + vbQuestion, "送信確認")
If ans = vbNo Then Exit Sub
' ─────────────────────────────────────────────────────
' ③ Outlook の起動確認
' ─────────────────────────────────────────────────────
Dim olApp As Object
On Error Resume Next
Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Outlook を起動できませんでした。" & Chr(10) & _
"Outlook がインストールされているか確認してください。", _
vbCritical, "Outlook エラー"
Exit Sub
End If
' ─────────────────────────────────────────────────────
' ④ メール送信ループ
' ─────────────────────────────────────────────────────
Dim successCount As Long
Dim skipCount As Long
Dim errorLog As String
successCount = 0
skipCount = 0
errorLog = ""
For r = 3 To lastRow
email = Trim(CStr(ws.Cells(r, COL_EMAIL).Value))
name = Trim(CStr(ws.Cells(r, COL_NAME).Value))
flag = Trim(CStr(ws.Cells(r, COL_FLAG).Value))
Dim amount As String
Dim month As String
amount = Format(ws.Cells(r, COL_AMOUNT).Value, "#,##0")
month = Trim(CStr(ws.Cells(r, COL_MONTH).Value))
' 送信済み・必須項目未入力はスキップ
If flag = "送信済み" Or email = "" Or name = "" Then
skipCount = skipCount + 1
GoTo NextRow
End If
' メールアドレスの簡易バリデーション（@と.が含まれるか）
If InStr(email, "@") = 0 Or InStr(email, ".") = 0 Then
errorLog = errorLog & " ・" & name & "（無効なメールアドレス：" & email & "）" & Chr(10)
skipCount = skipCount + 1
GoTo NextRow
End If
' メール作成・送信
On Error Resume Next
Dim mail As Object
Set mail = olApp.CreateItem(0)
mail.To = email
mail.Subject = "【ご請求】" & month & "分 請求金額のご案内"
mail.Body = name & " 御中" & Chr(13) & Chr(10) & _
Chr(13) & Chr(10) & _
"いつもお世話になっております。" & Chr(13) & Chr(10) & _
SENDER_NAME & " でございます。" & Chr(13) & Chr(10) & _
Chr(13) & Chr(10) & _
month & "分のご請求金額をご案内いたします。" & Chr(13) & Chr(10) & _
Chr(13) & Chr(10) & _
" ご請求金額：" & amount & " 円（税込）" & Chr(13) & Chr(10) & _
Chr(13) & Chr(10) & _
"詳細は添付の請求書をご確認ください。" & Chr(13) & Chr(10) & _
"ご不明な点がございましたら、お気軽にお問い合わせください。" & Chr(13) & Chr(10) & _
Chr(13) & Chr(10) & _
"何卒よろしくお願いいたします。"
If AUTO_SEND Then
mail.Send
Else
mail.Display
End If
Dim sendErr As String
sendErr = ""
If Err.Number <> 0 Then sendErr = Err.Description
Err.Clear
On Error GoTo 0
If sendErr <> "" Then
errorLog = errorLog & " ・" & name & "（送信エラー：" & sendErr & "）" & Chr(10)
skipCount = skipCount + 1
Else
ws.Cells(r, COL_FLAG).Value = "送信済み"
successCount = successCount + 1
End If
Set mail = Nothing
NextRow:
Next r
' ─────────────────────────────────────────────────────
' ⑤ 完了メッセージ
' ─────────────────────────────────────────────────────
Dim resultMsg As String
resultMsg = "✅ 処理が完了しました！" & Chr(10) & Chr(10) & _
" ・送信成功 ：" & successCount & " 社" & Chr(10) & _
" ・スキップ ：" & skipCount & " 件"
If errorLog <> "" Then
resultMsg = resultMsg & Chr(10) & Chr(10) & _
"⚠️ 以下の送信に失敗しました：" & Chr(10) & errorLog
End If
If Not AUTO_SEND Then
resultMsg = resultMsg & Chr(10) & Chr(10) & _
"※ 下書きモードで開いています。" & Chr(10) & _
"内容を確認してから手動で送信してください。"
End If
MsgBox resultMsg, vbInformation, "送信完了"
End Sub当該VBAの便利ポイント
このVBAコードの便利なポイントは以下の通りです。
- 宛先・件名・本文を1件ずつ自動生成できる
手作業で送る場合、メールを1通ずつ開いて宛先を入力し、件名と本文を作成するたびに「取引先名」「請求金額」「対象月」を貼り替える必要があります。VBAを使えば、Excelリストの各行から宛先・件名・本文を自動で生成するため、件数が50社でも100社でも作業時間はほぼ変わりません。 - 送信済みの管理が自動化される
手作業では「どこまで送ったか」を別のメモや色塗りで管理することが多く、送り漏れや二重送信のリスクがあります。このVBAは送信が完了した行に自動で「送信済み」と記録するため、リストを見れば状況が一目でわかります。次回の実行時も「送信済み」の行は自動でスキップされるため、誤って同じ相手に二度送ることがありません。 - 送信前に確認ステップを挟める
AUTO_SEND = Falseの設定では、Outlookの作成画面が表示された状態で止まるため、内容を目視確認してから手動で送信できます。定型文の誤字や金額の入力ミスを最後に確認できる安全ステップとして機能します。問題がなければAUTO_SEND = Trueに切り替えるだけで完全自動送信に移行できます。 - メールアドレスの不備を事前に検出できる
リストにメールアドレスが未入力の行や、明らかに形式がおかしい値（@や.がない）が含まれていた場合、その行を自動でスキップしてエラーログに記録します。手作業では「送信エラーに気づかず放置されていた」というケースが起きやすいですが、VBAなら実行後に「送信できなかった取引先」が一覧で表示されるため、漏れなく対処できます。
導入効果の目安
顧客50社への個別メール送信を手作業で行うと、1通あたり2〜3分の入力・確認作業が発生し、合計で約2時間かかります。
VBAを使えば宛先・件名・本文の生成から送信済み管理まで自動化され、同じ作業が5〜10分以内に完了します。入力ミスや送り漏れもゼロになるため、月次の定期送信業務では工数削減と品質向上を同時に実現できます。
VBAを導入するときの注意点と「引き継ぎ問題」の解決策
VBAには「担当者が退職したら誰も触れなくなった」という問題が実際の現場でよく起きます。私がコンサルタントとして支援してきた中小企業でも、「前任者がVBAで作った集計ツールがあるが、何をしているのか誰も分からない。修正できないから怖くて使えていない」という相談は珍しくありません。
これはVBAの欠点ではなく、引き継ぎの準備をしなかったことが原因です。以下の3点セットを最初から用意することで、VBAの属人化は防げます。
コード内コメントの徹底
VBAのコード内に処理の意図を日本語でコメントしておきます。
' ★ ここから集計処理 ★
' 目的：各月シートのB〜D列のデータを集計シートに積み上げる
' 対象シート：sheetNamesに配列で指定（月名を追加・変更して使う）
コメントがあるだけで、VBAを書いたことがない人でも「このコードが何をしているか」をおおよそ理解できます。操作マニュアルの整備
「どのボタンをいつ押すか」「どのシートに何を入力するか」を操作マニュアルとして残します。VBAの使い方マニュアルは、通常の業務マニュアルと同じ要領で作成できます。
修正依頼の窓口を決める
「VBAに何か問題が起きたときに誰に聞くか」を明確にしておきます。社内に詳しい人がいなければ、外部のITコンサルタントや制作者の連絡先を残しておくだけでも十分です。
この3点セットを整備しておけば、担当者が変わってもVBAを安心して使い続けることができます。
生成AIを使えばVBAコードをゼロから書かなくてよい
VBA導入のもう一つのハードルだった「コードを書く」という作業が、生成AIの登場で大きく変わりました。ChatGPT・Gemini・Claudeなどの生成AIに「やりたいことを日本語で説明する」だけで、動作するVBAコードを出力してくれます。プログラミング経験がなくても、自分の業務に合ったVBAを手に入れられる時代になっています。
生成AIへのプロンプトの書き方
コードを出力させるコツは「何をしたいか」を具体的に伝えることです。以下のような形で質問するだけでVBAコードが得られます。
プロンプト例①（シートの集計）
ExcelのVBAコードを書いてください。
「1月」〜「12月」という名前の12枚のシートがあります。
各シートのB列2行目からD列のデータを、「集計」シートに順番に積み上げてください。
最後に処理件数をメッセージボックスで表示してください。
プロンプト例②（請求書の自動作成）
ExcelのVBAコードを書いてください。
「データ」シートのA列に取引先名、B列に請求金額、C列に請求書番号が入っています。
「請求書テンプレート」シートのB3に取引先名、E8に金額、B1に請求書番号を転記して、
取引先名のファイル名でPDF保存するマクロを作ってください。
このように「シート名」「列の位置」「保存先」など具体的な条件を添えるほど、そのまま使えるコードが返ってきます。
生成されたコードを使うときの3つの注意点
生成AIのコードは非常に便利ですが、そのまま本番運用する前に必ず確認すべき点があります。
① 必ずテスト用ファイルで動作確認する
生成されたコードが意図した通りに動くか、本番データのコピーを使って先に確認します。誤動作でデータが上書き・削除されても元に戻せるよう、バックアップを取ってから実行するのが鉄則です。
② 機密データをプロンプトに貼り付けない
顧客の個人情報・売上データ・社員情報などの実データをそのまま生成AIに入力しないようにします。データの「構造（列の位置・シート名）」だけを説明すれば、実際のデータがなくてもコードを生成できます。また、AIの認識用やVBA完成後の検証用に、サンプルのExcelデータをAIに作らせる方法もお勧めです。
③ エラーが出たら生成AIに修正させる
「このコードを実行したら〇〇というエラーが出ました」と伝えると、原因を分析して修正案を返してくれます。エラー文をそのままコピーして貼り付けるだけでよいので、デバッグ（修正）の手間も大幅に減ります。
生成AIとVBAの組み合わせが特に向いているケース
生成AI×VBAの組み合わせが最も威力を発揮するのは、「やりたいことは明確だが、コードの書き方が分からない」という状況です。本記事の5事例のような定型処理であれば、ほとんどのケースで動作するコードが簡単に生成できます。
一方、複雑なビジネスロジックや複数のシステムをまたぐ処理は、生成AIが一発で正しいコードを出せないこともあります。その場合は処理を小さく分けて、1つずつ生成・確認していくアプローチが現実的です。
よくある質問（FAQ）
Q. VBAを使うのにプログラミングの知識は必要ですか？
ゼロから書くには多少の学習が必要ですが、本記事で紹介したようなコードをコピーして自社の業務に合わせて修正するだけであれば、プログラミング未経験でも対応できます。また、生成AIを活用したVBA作成は誰でも取り組めるため、まずはVBAの勉強よりも生成AIの使い方から勉強するのも良いでしょう。
Q. VBAを使い始めるにはどうすればいいですか？
Excelのリボンメニューにある「ファイル」→「オプション」→「リボンのユーザー設定」で「開発」にチェックを入れると、「開発」タブが表示されます。「Visual Basic」ボタンをクリックするとVBAの編集画面（VBエディタ）が開き、コードを書いて実行できるようになります。
Q. Excel VBAとPower Automateはどう使い分ければいいですか？
Excel上の作業（シート間のコピー・集計・PDF保存など）が主な課題であればVBAが適しています。複数のアプリケーションをまたぐ処理（Webフォームへの入力・メールシステムとの連携・クラウドサービスへのアップロードなど）はPower Automateが向いています。まずVBAで小さな自動化を体験し、「もっと広い範囲を自動化したい」と感じたときにPower Automateへ移行するルートが現場での定着率も高く、おすすめです。
Q. Excel VBAはどんな業務に向いていませんか？
判断が必要なイレギュラー対応、顧客との交渉、経営判断など「毎回状況が変わる業務」はVBAには向きません。VBAが最も力を発揮するのは「毎回同じ手順で、ルールが決まっている」繰り返し作業です。本記事の5事例はいずれもその条件を満たしています。
Q. VBAを外部に依頼する場合の費用感は？
業務内容・難易度・ボリュームによって異なりますが、シンプルな集計用のVBA1本であれば数万円〜十数万円が目安です。ただし、外部に依頼する前に「そのVBAが継続的にメンテナンスできる体制を社内に作れるか」を確認することをおすすめします。外部依存が強くなると、小さな修正のたびに費用が発生し続けるためです。
まとめ：Excel VBAは中小企業の「最初の自動化」に最適
本記事では、Excel VBAを使った業務効率化の具体的なVBAマクロ事例5選を解説しました。最後に要点を整理します。
Excel VBAとは、ExcelなどMicrosoft Office製品に標準搭載されたプログラミング言語で、追加費用ゼロで定型作業の自動化を実現できるツールです。
中小企業にVBAが向いている理由は、Excelがすでに業務の中心にあり、IT担当者不在でも「作る人」と「使う人」を分けて運用でき、1業務から小さく始められる点にあります。
本記事で紹介した5つの活用事例は次のとおりです。
- 複数シートのデータを月次集計レポートに集約
- 請求書テンプレートへの自動転記＋PDF一括保存
- 入力フォームからデータ台帳に自動登録
- 不要行の自動削除とデータクレンジング
- Outlookメールの一括自動作成
VBAを長く使い続けるには、コード内コメント・操作マニュアル・修正窓口の3点セットを整備して引き継ぎ問題を防ぐことが重要です。まずやることは、自社で毎月繰り返している作業を1つ選び、今日VBエディタを開いて本記事のコードをコピー＆ペーストして動かしてみることです。
Excel VBAによる業務効率化について、もっと具体的なアドバイスが欲しい方は、60分の簡易業務診断（無料相談）をお気軽にご利用ください。（毎週１社限定）
投稿者プロフィール
- ベイズマネジメント代表
- 中小企業診断士・事業承継士・属人化解消コンサルタント｜マニュアル制作会社に13年勤め、300種類以上の業務マニュアルの制作、ドキュメント管理システムの開発に従事。現在は中小企業の業務効率化・属人化解消を支援するコンサルタントとして独立。マニュアル整備による教育の自動化やIT導入による生産性向上で、年間640時間の残業削減を実現した支援実績を持つ。
最新の投稿
業務効率化2026-04-13ものづくり補助金で業務改善・DXを実現する方法【2026年版】- 補助金･助成金2026-04-12補助金×業務改善完全ガイド｜ものづくり・IT導入・省力化投資補助金の活用法
- 業務効率化2026-04-11kintoneを中小企業が使うメリット｜導入前に知るべき費用・活用事例・失敗パターン
- 業務効率化2026-04-10建設業の業務改善｜業務コンサルが解説する現場・事務所間の情報連携の改善法
