- 上級向け 演習問題（10問）
- 問題 1：複数プロシージャ分割（請求書番号の発番）
- 問題 2：ByRef でリストを加工
- 問題 3：可変引数 ParamArray の利用
- 問題 4：複数シートの一括検査
- 問題 5：辞書（Scripting.Dictionary）と Sub 分割
- 問題 6：日付チェックのモジュール化
- 問題 7：ファイル存在チェックの共通化
- 問題 8：多次元配列の加工 Sub
- 問題 9：CSV の行数カウントを関数化
- 問題 10：モジュール化されたログ記録機能
- 問題1：模範解答
- 問題2：模範解答
- 問題3：模範解答
- 問題4：模範解答
- 問題5：模範解答
- 問題 6：模範解答
- 問題 7：模範解答
- 問題 8：模範解答
- 問題 9：模範解答
- 問題 10：模範解答
上級向け 演習問題（10問）
ここでは 「Subプロシージャ」「引数」「ByRef / ByVal」「処理の分割」などを総合的に使う“上級向け”の10問 を用意し、
すべてに模範解答＋丁寧な解説 をつけています。
以下の内容は 実務でもそのまま使える構成力・整理力・保守性 を鍛える問題です。
問題 1：複数プロシージャ分割（請求書番号の発番）
【仕様】
- 請求書番号は
YYYYMM-連番3桁
（例：202511-001） - シート「管理」の
- A1：最新年月（例：202511）
- A2：最新番号（例：15）
- ボタン実行で「次の番号」を発行してメッセージ表示。
- 番号計算・書き込み・表示 を別々の Sub に分割すること。
問題 2：ByRef でリストを加工
【仕様】
- 配列
arr = Array(5, 2, 9, 1, 3) - 別 Sub を作り「小さい順にソートして」戻す
- ByRef を使用して 元の配列が書き換わる ようにする。
問題 3：可変引数 ParamArray の利用
【仕様】
- ParamArray を持つ Sub を作り
任意個の数値の「平均値」を計算して MsgBox で表示。
問題 4：複数シートの一括検査
【仕様】
- 引数
sheetNamesに配列を渡す - 各シートの A1 が 空 のものを「問題あり」シートとして収集
- 最後に一覧を MsgBox で表示
- 処理は「チェック」「集計」「表示」を別 Sub に分ける。
問題 5：辞書（Scripting.Dictionary）と Sub 分割
【仕様】
- A列：商品名
- B列：数量
- 同一商品の数量を合計し、Dictionary にまとめる。
- 結果をメッセージで表示
- 集計と表示を別プロシージャ化。
問題 6：日付チェックのモジュール化
【仕様】
- 任意セルの値を渡すと「正しい日付か？」を True/False で返す Function を作る。
- Sub 側で「正しい日付だけを緑色」「不正は赤色」に塗る。
問題 7：ファイル存在チェックの共通化
【仕様】
- ボタンを押すとフォルダパス＋ファイル名を入力。
- 別プロシージャでファイル存在判定。
- 結果を Sub 側のメッセージで表示。
問題 8：多次元配列の加工 Sub
【仕様】
- 3×3 の配列を渡す
- 「行ごとの合計」を求めて 1 次元配列で返す
- 引数は「ByVal」を指定し、中のデータは書き換えない。
問題 9：CSV の行数カウントを関数化
【仕様】
- ファイルパスを引数に
- CSV の行数を返す Function
- Sub 側で「行数」を MsgBox 表示
問題 10：モジュール化されたログ記録機能
【仕様】
- 引数「メッセージ文字列」を受け取る Sub LogWrite
- シート「ログ」に「日時」「メッセージ」を追記
- 任意の処理から呼び出せる設計にする。
問題1：模範解答
Sub 発行メイン()
Dim nextNo As String
nextNo = CreateInvoiceNumber() '番号作成
SaveInvoiceNumber nextNo '書き込み
ShowNumber nextNo '表示
End Sub
Function CreateInvoiceNumber() As String
Dim yyyymm As String
Dim no As Long
yyyymm = Sheets("管理").Range("A1").Value
no = Sheets("管理").Range("A2").Value + 1
CreateInvoiceNumber = yyyymm & "-" & Format(no, "000")
End Function
Sub SaveInvoiceNumber(ByVal num As String)
Dim parts() As String
parts = Split(num, "-")
Sheets("管理").Range("A1").Value = parts(0)
Sheets("管理").Range("A2").Value = CLng(parts(1))
End Sub
Sub ShowNumber(ByVal num As String)
MsgBox "新しい請求書番号：" & num
End Sub
解説
- 処理を 3 分割（作成・保存・表示）
- CreateInvoiceNumber は値を返す Function
- Sub 同士で役割が明確 → 実務で必須
問題2：模範解答
Sub SortMain()
Dim arr As Variant
arr = Array(5, 2, 9, 1, 3)
SortArray arr 'ByRef で元の配列が書き換わる
MsgBox Join(arr, ", ")
End Sub
Sub SortArray(ByRef ary As Variant)
Dim i As Long, j As Long, tmp
For i = LBound(ary) To UBound(ary) - 1
For j = i + 1 To UBound(ary)
If ary(j) < ary(i) Then
tmp = ary(i)
ary(i) = ary(j)
ary(j) = tmp
End If
Next j
Next i
End Sub
解説
ByRefで渡すと ary(i) を書き換えると arr も書き換わる
問題3：模範解答
Sub AverageMain()
Call ShowAverage(10, 20, 30, 40, 50)
End Sub
Sub ShowAverage(ParamArray nums() As Variant)
Dim i As Long, total As Double
For i = LBound(nums) To UBound(nums)
total = total + nums(i)
Next i
MsgBox "平均値：" & total / (UBound(nums) - LBound(nums) + 1)
End Sub
✔ 可変引数 ParamArray の基本。
問題4：模範解答
Sub CheckSheetsMain()
Dim targets As Variant
targets = Array("商品", "在庫", "受注")
Dim badList As Variant
badList = CheckSheetsEmptyA1(targets)
ShowResult badList
End Sub
Function CheckSheetsEmptyA1(sheetNames As Variant) As Variant
Dim tmp() As String
Dim count As Long: count = -1
Dim s As Variant
For Each s In sheetNames
If Sheets(s).Range("A1").Value = "" Then
count = count + 1
ReDim Preserve tmp(count)
tmp(count) = s
End If
Next
CheckSheetsEmptyA1 = tmp
End Function
Sub ShowResult(list As Variant)
If UBound(list) < 0 Then
MsgBox "問題なし"
Exit Sub
End If
MsgBox "A1 が空のシート：" & vbCrLf & Join(list, vbCrLf)
End Sub
問題5：模範解答
Sub DictionaryMain()
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Call CollectData(dic)
Call ShowDic(dic)
End Sub
Sub CollectData(dic As Object)
Dim i As Long, lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim key As String
Dim val As Long
For i = 2 To lastRow
key = Cells(i, 1).Value
val = Cells(i, 2).Value
If dic.Exists(key) Then
dic(key) = dic(key) + val
Else
dic.Add key, val
End If
Next i
End Sub
Sub ShowDic(dic As Object)
Dim k As Variant, msg As String
For Each k In dic.Keys
msg = msg & k & "：" & dic(k) & vbCrLf
Next
MsgBox msg
End Sub
問題 6：模範解答
メイン処理（Sub）
Sub DateCheckMain()
Dim rng As Range
For Each rng In Selection
If IsValidDate(rng.Value) Then
rng.Interior.Color = vbGreen
Else
rng.Interior.Color = vbRed
End If
Next rng
End Sub
日付チェック用 Function
Function IsValidDate(v As Variant) As Boolean
On Error Resume Next
IsValidDate = IsDate(v)
End Function
解説
役割分担がポイント
DateCheckMain
→ セルを塗る・全体の流れを管理IsValidDate
→ 日付の判定だけを担当
IsDate を使う最強のシンプル解法
Excel は "2025/1/1" でも "1-1-2025" でも日付と判定可能。
日付に変換できない値：文字列や空欄など → False。
問題 7：模範解答
メイン
Sub FileCheckMain()
Dim path As String
path = InputBox("パスを入力してください")
If CheckFileExists(path) Then
MsgBox "ファイルがあります"
Else
MsgBox "ファイルがありません"
End If
End Sub
共通化されたファイルチェック Sub（Function）
Function CheckFileExists(path As String) As Boolean
CheckFileExists = (Dir(path) <> "")
End Function
解説
Dir 関数で存在確認
Dir(path) が
- ファイルあり → ファイル名が返る
- なし → 空文字
共通関数化のメリット
どのモジュールからでも
If CheckFileExists("C:\data.csv") Then ...
と一発で呼び出せる。
→ 保守性が一気に向上する実務向けパターン
問題 8：模範解答
メイン
Sub MultiArrayMain()
Dim arr(1 To 3, 1 To 3) As Long
Dim i As Long, j As Long
'値をセット（例）
For i = 1 To 3: For j = 1 To 3
arr(i, j) = i * 10 + j
Next j: Next i
Dim result As Variant
result = SumRows(arr)
MsgBox "行合計：" & Join(result, ", ")
End Sub
行ごとの合計を返す Function
Function SumRows(ByVal mat As Variant) As Variant
Dim r As Long, c As Long
Dim rowCnt As Long, colCnt As Long
rowCnt = UBound(mat, 1)
colCnt = UBound(mat, 2)
Dim sums() As Long
ReDim sums(1 To rowCnt)
For r = 1 To rowCnt
For c = 1 To colCnt
sums(r) = sums(r) + mat(r, c)
Next c
Next r
SumRows = sums
End Function
解説
引数を ByVal で渡す理由
問題文指定：「元の配列を変更しない」
ByRef → 配列を書き換える可能性あり
ByVal → 安全に読み取りだけ
返り値は 1 次元配列
3 行分の合計値 → {合計1, 合計2, 合計3}
問題 9：模範解答
メイン
Sub CountCsvMain()
Dim path As String
path = InputBox("CSV のパスを入力してください")
Dim cnt As Long
cnt = CountCsvLines(path)
MsgBox "行数：" & cnt
End Sub
行数を返す Function
Function CountCsvLines(path As String) As Long
Dim f As Integer
Dim line As String
Dim count As Long
If Dir(path) = "" Then Exit Function
f = FreeFile
Open path For Input As #f
Do Until EOF(f)
Line Input #f, line
count = count + 1
Loop
Close #f
CountCsvLines = count
End Function
解説
FreeFile + Open + Line Input の定番パターン
FreeFile→ 空いているファイル番号を取得Open ... For Input→ 読み込みモードLine Input #f, line→ 1行ずつ読み込むEOF(f)→ 最後まで読んだか判定
CSV の行数カウントとして非常に実務向け。
問題 10：模範解答
任意の処理から呼び出されるメイン
Sub DoSomething()
'何らかの処理
Call LogWrite("処理を開始しました")
Call LogWrite("データチェック完了")
Call LogWrite("処理終了")
End Sub
ログ記録 Sub
Sub LogWrite(msg As String)
Dim sh As Worksheet
Set sh = Sheets("ログ")
Dim nextRow As Long
nextRow = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
sh.Cells(nextRow, 1).Value = Now
sh.Cells(nextRow, 2).Value = msg
End Sub
解説
ログを残す設計は実務で大前提
システムでは「何が行われたか」を記録しないと
トラブル対応ができないため、ほぼ必須。
Sub LogWrite によって共通化
LogWrite "メッセージ"
と書くだけで
日時とメッセージを自動記録。
→ 最高に便利！
