希少価値のある年号の硬貨を判別してくれるワークシート作ってみた

どうも、fです。
この前LINEのタイムラインで、書かれている額面よりも実際の価値が高い硬貨の表が回ってきたので、所持金を確認してみようと思いました。
ですが、あまりに小銭が多すぎて一瞬でやる気なくしましたww

小銭多すぎ(ケースに入ってるのは100円玉)

というわけで、Excelを使い、持っている硬貨の額、元号、年を入力することで、それらの情報をデータベースと照合し、換金した時の額を算出してくれるソフトを作りました。
完成したものはコチラ!↓
A列に硬貨の額、B列にその硬貨の元号(データベースに書いてある方式で。私の場合はアルファベット表記)、C列にその年を書いていき、全て入力が終わったところで「計算」ボタンを押します。
すると、D列に硬貨の実際の価値が表示され、希少価値のある硬貨が混じっていれば水色にマークされます。(もちろんD列への表記も変わります)

昭和61年の10円玉(18円分の価値)がマークされている様子。

結局、全部の所持金を入力したのですが、(1時間位かかった)混じっていた希少な硬貨は先ほどの画像の、昭和61年の10円玉だけでした。がっかり...
因みに、スクショは撮り忘れてしまいましたが、きちんとA列の合計(硬貨としての価値)、D列の合計(換金した時の金額)も表示してくれます。
「削除」のボタンを押せば、記入した内容を全て消すことができます。
もし、作りたいという方がいましたら、その人のためにソースコード貼っておきます。

Vbaのコード

Sub calculation()
Dim num1, num2
num1 = 1
num2 = 1
Do Until num1 = WorksheetFunction.CountA(Range("A:A"))
num1 = num1 + 1
Cells(num1, 4).Value = Cells(num1, 1).Value
Cells(num1, 1).ClearFormats
Cells(num1, 2).ClearFormats
Cells(num1, 3).ClearFormats
Cells(num1, 4).ClearFormats
Loop
num1 = 1
Do Until num1 = WorksheetFunction.CountA(Range("A:A"))
num1 = num1 + 1
num2 = 0
Do Until num2 = WorksheetFunction.CountA(Range("L:L"))
num2 = num2 + 1
If Cells(num1, 1).Value = Cells(num2, 12).Value And Cells(num1, 2).Value = Cells(num2, 13).Value And Cells(num1, 3).Value = Cells(num2, 14).Value Then
Cells(num1, 4).Value = Cells(num2, 15).Value
Cells(num1, 1).Interior.Color = RGB(0, 255, 255)
Cells(num1, 2).Interior.Color = RGB(0, 255, 255)
Cells(num1, 3).Interior.Color = RGB(0, 255, 255)
Cells(num1, 4).Interior.Color = RGB(0, 255, 255)
End If
Loop
Loop
End Sub
Sub reset()
Dim num1, num2
num1 = 1
num2 = WorksheetFunction.CountA(Range("A:A"))
Do Until num1 = num2
num1 = num1 + 1
Cells(num1, 1).Clear
Cells(num1, 2).Clear
Cells(num1, 3).Clear
Cells(num1, 4).Clear
Cells(num1, 1).ClearFormats
Cells(num1, 2).ClearFormats
Cells(num1, 3).ClearFormats
Cells(num1, 4).ClearFormats
Loop
End Sub

詳しい説明は面倒なのでナシです。
Vbaは触ったことがなかったのですが、Vbsに構文が似ていたので助かりましたww
この方式なら、希少価値のある硬貨の種類が増えても、データベースにそれを追記するだけで登録できます。
それでは。(いい挨拶が思い浮かばなかった)