Excelで100マス計算のシート作成

久しぶりに梅漬けてます。お酒でない方。お酒禁止されてるので。かき氷が楽しみ。

100マス計算で下記サイトにお世話になっていました。

dailywork.net

大変ありがたかったのですが、ひとつ難点を申し上げると、問題と答えのセットが24時間切り替えなんですね。私のようなものぐさだと、息子に問題を解かせてから、答え合わせをするのに0時を回っていることはしばしば。こうなると、答えを閲覧することができなくなってしまうので、思考停止状態の私は、自分で解いて、答え合わせしていました。5日分ほど溜めてしまうと、もう泣きたくなります。

そんなわけで、Excelの関数ですぐに答えを確認できるようにしたのが事の始まり。どうせなら問題も自力で作成したらいいじゃないかと、会社辞めてから久しぶりにVBAをいじりました。

作成したコードがこちら。（抜粋ですが…）

For i = 0 To 9
Cells(i + 1, 1).Value = i
Next

For i = 0 To 9
n = Int(Rnd * 10)

Do While Cells(n + 1, 1).Value = ""
n = Int(Rnd * 10)
Loop

Cells(3 + i, 2) = Cells(n + 1, 1)
Cells(n + 1, 1).Clear
Next

最初のFor～NextでA列に1～９までの数字を入力。

次のFor～Next、Rnd関数を使ってA列からランダムに数字をコピーしてくるのですが、ここでコピーした数字は削除する、つまりカット＆ペーストします。あとはコピーする際に、コピー元が空白、つまり一度使われた数だと、別の数を選び直すようにします。これで0～9までの数字がかぶらずに入力されると。

VBA得意な方でしたら、もっとスマートな方法で5分ほどでできちゃうんでしょうが、私的には数時間かかりました。でも、久しぶりに頭の使われていない場所を使ったみたいで、達成感がありました。

需要があるとは思いませんが、一応コード全文を載せておきます。説明としては、A4サイズの用紙に、足し算とひき算の100マス問題を1つずつ印刷するようにできています。マクロは3つ、①問題を作成する、②答えを表す、③答えを消す、で構成されています。それぞれにショートカットを割り当てると便利かと。

Sub mondai()

For i = 0 To 9
Cells(i + 1, 1).Value = i
Next

For i = 0 To 9
n = Int(Rnd * 10)

Do While Cells(n + 1, 1).Value = ""
n = Int(Rnd * 10)
Loop

Cells(3 + i, 2) = Cells(n + 1, 1)
Cells(n + 1, 1).Clear
Next

For i = 0 To 9
Cells(i + 1, 1).Value = i
Next

For i = 0 To 9
n = Int(Rnd * 10)

Do While Cells(n + 1, 1).Value = ""
n = Int(Rnd * 10)
Loop

Cells(2, 3 + i) = Cells(n + 1, 1)
Cells(n + 1, 1).Clear
Next

For i = 0 To 9
Cells(i + 1, 1).Value = i
Next

For i = 0 To 9
n = Int(Rnd * 10)

Do While Cells(n + 1, 1).Value = ""
n = Int(Rnd * 10)
Loop

Cells(15 + i, 2) = Cells(n + 1, 1)
Cells(n + 1, 1).Clear
Next

For i = 0 To 9
Cells(i + 1, 1).Value = i + 10
Next

For i = 0 To 9
n = Int(Rnd * 10)

Do While Cells(n + 1, 1).Value = ""
n = Int(Rnd * 10)
Loop

Cells(14, 3 + i) = Cells(n + 1, 1)
Cells(n + 1, 1).Clear
Next

End Sub

Sub kotae()

n = 0

Do Until n = 10

For i = 0 To 9
Cells(3 + i, 3 + n) = Cells(3 + i, 2) + Cells(2, 3 + n)
Next

n = n + 1

Loop

n = 0

Do Until n = 10

For i = 0 To 9
Cells(15 + i, 3 + n) = Cells(14, 3 + n) - Cells(15 + i, 2)
Next

n = n + 1

Loop

End Sub

Sub clr()
Range("C3:L12").ClearContents
Range("C15:L24").ClearContents
End Sub