平成26年度春期基本情報技術者_表計算のマクロをExcelVBAで再現する
目次
１．出典
２．問題で使用するExcelシート「匿名化顧客リスト」「提供リスト」のダミーデータの簡単な作り方
３．問題文の要旨
４．問題文（疑似言語）
５．解答群（疑似言語）
６．問題文（VBA翻訳）
７．VBA翻訳の補足説明
８．解答群（VBA翻訳）
９．正解
10．正解を入れたVBA完全版 ※動作確認済み
11．２次元配列バージョン ※動作確認済み
12．バックナンバー
13．ExcelVBA講座ご紹介
１．出典
経済産業省国家試験（IPA情報処理推進機構）
平成26年度春期 基本情報技術者試験 午後試験 選択問題 問13表計算設問２[解答欄d～f]
なお、試験問題及び正解の著作権はIPA情報処理推進機構に帰属します。
２．問題で使用するExcelシート「匿名化顧客リスト」「提供リスト」のダミーデータの簡単な作り方
シート「匿名化顧客リスト」
・A2～A5001：=RIGHT("0000"&ROW()-1,4)
・C2～C5001：=INT(RAND()*100)
・F2～F5001：=INDEX($K$2:$K$9,INT(RAND()*8+1),1)
・G2～G5001：=INT(RAND()*40+10)*10
・I2～I5001：=H2*10000000+C2*100000+F2*1000+G2
・B、D、E、H、L、M列はマクロとは無関係なので空白でも良い。
・C、F、G列はRand()を使ってダミーのデータを入力しているので値の貼り付けをして数式を消しておくこと。
シート「提供リスト」
・新規のシートを用意するだけ。すべてのセルを空白にする。
３．問題文の要旨
シート「匿名化顧客リスト」は顧客リストを暗号化（匿名化）したものであり、I列の評価値は郵便番号、年齢、職業コードを7桁の数値にしたものである。
マクロを実行すると、マーキング（H列）をすべて０とし、評価値が最小の顧客から順に処理をする。処理対象の顧客と、同じ評価値の顧客の数（多重度）を数えて、それが最小多重度（セルN2）以上であれば、郵便番号、年齢、職業コード、多重度をシート「提供リスト」に転記するとともに、マーキングの列に「１」を入力し、評価値に10000000を加算する。これを繰り返して、シート「提供リスト」を作りたい。
４．問題文（疑似言語）
[マクロ：GenerateList]
〇マクロ：GenerateList
〇数値型：numCustomer, minID, previousValue, minMultiplicity, I, J, K
・numCustomer ← 5000
・previousValue ← 0
・minMultiplicity ← N2
・相対(提供リスト!A1, 0, 0) ← '郵便番号'
・相対(提供リスト!A1, 0, 1) ← '年齢'
・相対(提供リスト!A1, 0, 2) ← '職業コード'
・相対(提供リスト!A1, 0, 3) ← '多重度'
■ I: 1, I<=numCustomer, 1
｜・相対(H1, I, 0) ← 0
■
・J ← 1
・K ← 0
■ I: 1, I<=numCustomer, 1
｜・minID ← [ 解答欄d ]
｜・相対(H1, minID, 0) ← 1
｜▲ 相対(I1, minID, 0) <> previousValue
｜｜▲ K >= minMultiplicity
｜｜｜・[ 解答欄e ]
｜｜▼
｜｜・相対(提供リスト!A1, J, 0) ← 相対(A1, minID, 2)
｜｜・相対(提供リスト!A1, J, 1) ← 相対(A1, minID, 5)
｜｜・相対(提供リスト!A1, J, 2) ← 相対(A1, minID, 6)
｜｜・K ← 1
｜｜・相対(提供リスト!A1, J, 3) ← K
｜｜・previousValue ← 相対(I1, minID, 0)
｜＋-----
｜｜・[ 解答欄f ]
｜｜・相対(提供リスト!A1, J, 3) ← K
｜▼
■
▲ 相対(提供リスト!A1, J, 3) < minMultiplicity
｜・相対(提供リスト!A1, J, 0) ← null
｜・相対(提供リスト!A1, J, 1) ← null
｜・相対(提供リスト!A1, J, 2) ← null
｜・相対(提供リスト!A1, J, 3) ← null
▼５．解答群（疑似言語）
dに関する解答群
ア 条件付個数(I2～I5001, >相対(I1, I, 0))
イ 条件付個数(I2～I5001, <相対(I1, I, 0))
ウ 照合一致(最小(I2～I5001), I2～I5001, 0)
エ 照合一致(最小(I2～I5001), I2～I5001, 1)
オ 照合一致(最大(I2～I5001), I2～I5001, 0)
カ 照合一致(最大(I2～I5001), I2～I5001, 1)
キ 相対(I1, I, 0)
ク 相対(I1, J, 0)
e, fに関する解答群
ア I ← I + 1
イ I ← I + J
ウ I ← I + K
エ J ← I
オ J ← J + 1
カ J ← J + K
キ J ← K + 1
ク K ← J
ケ K ← K + 1
コ K ← K + J
６．問題文（VBA翻訳）
Sub GenerateList()
Dim numCustomer As Integer, minID As Integer, previousValue As Long, minMultiplicity As Integer, I As Integer, J As Integer, K As Integer
numCustomer = 5000
previousValue = 0
minMultiplicity = Range("N2")
Sheets("提供リスト").Range("A1").Offset(0, 0) = "郵便番号"
Sheets("提供リスト").Range("A1").Offset(0, 1) = "年齢"
Sheets("提供リスト").Range("A1").Offset(0, 2) = "職業コード"
Sheets("提供リスト").Range("A1").Offset(0, 3) = "多重度"
For I = 1 To numCustomer
Range("H1").Offset(I, 0) = 0
Next
J = 1
K = 0
For I = 1 To numCustomer
minID = [ 解答欄d ]
Range("H1").Offset(minID, 0) = 1
If Range("I1").Offset(minID, 0) <> previousValue Then
If K >= minMultiplicity Then
[ 解答欄e ]
End If
Sheets("提供リスト").Range("A1").Offset(J, 0) = Range("A1").Offset(minID, 2)
Sheets("提供リスト").Range("A1").Offset(J, 1) = Range("A1").Offset(minID, 5)
Sheets("提供リスト").Range("A1").Offset(J, 2) = Range("A1").Offset(minID, 6)
K = 1
Sheets("提供リスト").Range("A1").Offset(J, 3) = K
previousValue = Range("I1").Offset(minID, 0)
Else
[ 解答欄f ]
Sheets("提供リスト").Range("A1").Offset(J, 3) = K
End If
Next
If Sheets("提供リスト").Range("A1").Offset(J, 3) < minMultiplicity Then
Sheets("提供リスト").Range("A1").Offset(J, 0) = ""
Sheets("提供リスト").Range("A1").Offset(J, 1) = ""
Sheets("提供リスト").Range("A1").Offset(J, 2) = ""
Sheets("提供リスト").Range("A1").Offset(J, 3) = ""
End If
End Sub７．VBA翻訳の補足説明
previousValueは桁が大きいのでAs Longとしました（全部Longにしたほうがいいかもしれませんが・・・）。
８．解答群（VBA翻訳）
dに関する解答群
ア WorksheetFunction.CountIf(Range("I2:I5001"), ">" & Range("I1").Offset(I, 0))
イ WorksheetFunction.CountIf(Range("I2:I5001"), "<" & Range("I1").Offset(I, 0))
ウ WorksheetFunction.Match(WorksheetFunction.Min(Range("I2:I5001")), Range("I2:I5001"), 0)
エ WorksheetFunction.Match(WorksheetFunction.Min(Range("I2:I5001")), Range("I2:I5001"), 1)
オ WorksheetFunction.Match(WorksheetFunction.Max(Range("I2:I5001")), Range("I2:I5001"), 0)
カ WorksheetFunction.Match(WorksheetFunction.Max(Range("I2:I5001")), Range("I2:I5001"), 1)
キ Range("I1").Offset(I, 0)
ク Range("I1").Offset(J, 0)e, fに関する解答群
ア I = I + 1
イ I = I + J
ウ I = I + K
エ J = I
オ J = J + 1
カ J = J + K
キ J = K + 1
ク K = J
ケ K = K + 1
コ K = K + J９．正解
カウントするのにセルに対して個数を毎回上書きして、最小値を超えていなければ次の行に進めず、最後にnullで消すというとんでもない意味不明なプログラムである。
d ウ
「評価値（I列）の最小の顧客を処理対象」とするので、最小値の照合一致しかない。
e オ
最小多重度を超えていたら、提供リストを次の行に進めるという意味でJのインクリメントをする。
f ケ
多重度に1を足すという意味でKのインクリメントをする。
10．正解を入れたVBA完全版 ※動作確認済み
Sub GenerateList()
Dim numCustomer As Integer, minID As Integer, previousValue As Long, minMultiplicity As Integer, I As Integer, J As Integer, K As Integer
numCustomer = 5000
previousValue = 0
minMultiplicity = Range("N2")
Sheets("提供リスト").Range("A1").Offset(0, 0) = "郵便番号"
Sheets("提供リスト").Range("A1").Offset(0, 1) = "年齢"
Sheets("提供リスト").Range("A1").Offset(0, 2) = "職業コード"
Sheets("提供リスト").Range("A1").Offset(0, 3) = "多重度"
For I = 1 To numCustomer
Range("H1").Offset(I, 0) = 0
Next
J = 1
K = 0
For I = 1 To numCustomer
minID = WorksheetFunction.Match(WorksheetFunction.Min(Range("I2:I5001")), Range("I2:I5001"), 0)
Range("H1").Offset(minID, 0) = 1
If Range("I1").Offset(minID, 0) <> previousValue Then
If K >= minMultiplicity Then
J = J + 1
End If
Sheets("提供リスト").Range("A1").Offset(J, 0) = Range("A1").Offset(minID, 2)
Sheets("提供リスト").Range("A1").Offset(J, 1) = Range("A1").Offset(minID, 5)
Sheets("提供リスト").Range("A1").Offset(J, 2) = Range("A1").Offset(minID, 6)
K = 1
Sheets("提供リスト").Range("A1").Offset(J, 3) = K
previousValue = Range("I1").Offset(minID, 0)
Else
K = K + 1
Sheets("提供リスト").Range("A1").Offset(J, 3) = K
End If
Next
If Sheets("提供リスト").Range("A1").Offset(J, 3) < minMultiplicity Then
Sheets("提供リスト").Range("A1").Offset(J, 0) = ""
Sheets("提供リスト").Range("A1").Offset(J, 1) = ""
Sheets("提供リスト").Range("A1").Offset(J, 2) = ""
Sheets("提供リスト").Range("A1").Offset(J, 3) = ""
End If
End Sub
11．２次元配列バージョン ※動作確認済み
問題の趣旨を変えないまま２次元配列に置き換えてみました。
Sub GenerateList()
numCustomer = 5000
previousValue = 0
minMultiplicity = Range("N2")
a = Range(Cells(2, 1), Cells(numCustomer + 1, 8))
ReDim hyoka(numCustomer - 1)
ReDim teikyo(numCustomer, 3)
teikyo(0, 0) = "郵便番号"
teikyo(0, 1) = "年齢"
teikyo(0, 2) = "職業コード"
teikyo(0, 3) = "多重度"
For I = 1 To numCustomer
a(I, 8) = 0
hyoka(I - 1) = a(I, 3) * 100000 + a(I, 6) * 1000 + a(I, 7)
Next
J = 1
K = 0
For I = 1 To numCustomer
minID = WorksheetFunction.Match(WorksheetFunction.Min(hyoka), hyoka, 0)
a(I, 8) = 1
hyoka(minID - 1) = hyoka(minID - 1) + 10000000
If hyoka(minID - 1) <> previousValue Then
If K >= minMultiplicity Then
J = J + 1
End If
teikyo(J, 0) = a(minID, 3)
teikyo(J, 1) = a(minID, 6)
teikyo(J, 2) = a(minID, 7)
K = 1
teikyo(J, 3) = K
previousValue = hyoka(minID - 1)
Else
K = K + 1
teikyo(J, 3) = K
End If
Next
If teikyo(J, 3) < minMultiplicity Then
teikyo(J, 0) = ""
teikyo(J, 1) = ""
teikyo(J, 2) = ""
teikyo(J, 3) = ""
End If
Sheets("提供リスト").Range("A1").Resize(J, 4) = teikyo
End Sub
さらに、Match(Min(配列))を使わない高速バージョンです。
Sub GenerateList()
numCustomer = 5000
previousValue = 0
minMultiplicity = Range("N2")
a = Range(Cells(2, 1), Cells(numCustomer + 1, 7))
ReDim hyoka(numCustomer - 1)
ReDim teikyo(numCustomer, 3)
teikyo(0, 0) = "郵便番号"
teikyo(0, 1) = "年齢"
teikyo(0, 2) = "職業コード"
teikyo(0, 3) = "多重度"
For I = 1 To numCustomer
hyoka(I - 1) = a(I, 3) * 100000 + a(I, 6) * 1000 + a(I, 7)
Next
J = 1
K = 0
For I = 1 To numCustomer
hyokamin = hyoka(0)
minID = 1
For L = 2 To numCustomer
If hyokamin > hyoka(L - 1) Then
hyokamin = hyoka(L - 1)
minID = L
End If
Next
hyoka(minID - 1) = hyoka(minID - 1) + 10000000
If hyoka(minID - 1) <> previousValue Then
If K >= minMultiplicity Then
J = J + 1
End If
teikyo(J, 0) = a(minID, 3)
teikyo(J, 1) = a(minID, 6)
teikyo(J, 2) = a(minID, 7)
K = 1
teikyo(J, 3) = K
previousValue = hyoka(minID - 1)
Else
K = K + 1
teikyo(J, 3) = K
End If
Next
Sheets("提供リスト").Range("A1").Resize(J, 4) = teikyo
End Sub
12．バックナンバー
13．ExcelVBA講座ご紹介
この記事が気に入ったらサポートをしてみませんか？