【検】エクセルがあれば使える!!京都検定学習虎の穴ツール

【検】:チャレンジ!!京都検定
~試験直前に読んだら受かったりなんかして。



GW中、特に出かける予定が無かったので、夕方からエクセルのVBA(マクロ)を組んで、京都検定学習用ツールを作ってみました。問題と解答を自分で登録して使えるので、単語帳感覚で使えますが、単語帳より便利な所は

1.毎回、問題の順番が変わりますので、問題の順番で正解を覚えてしまうことがありません。
2.間違えると最初から1問目からやり直しになりますので、ゲーム感覚で繰り返し学習できます。(やり直しになる場合も問題の順番が変わります。)
3.問題の順番が変わる時に、間違えた問題が優先して出てきます。
4.10回以上、正解した問題は、問題保管庫に移されますが、任意で元に戻すことが可能です。
5.正解が複数ある場合は、(エクセルの総列数-3)の数値だけ登録できます。
6.正解はテキストボックスに入力します。選択肢ではないので確実に覚えられます。

検討中な所は、
1.登録された正解と全く同じでなければなりません。正解に「西国支配」と登録したら「西国の支配」では不正解になります。
2.複数正解がある場合は、正解に登録されている順番と同じに解答しなければなりません。正解と正解の間は全角の空白が入ります。Q天台宗三門跡寺院は?→A.「三千院 青蓮院 妙法院」という具合です。

エクセルファイルのアップが出来る場所が無いので、作り方をご説明すると
1.エクセルファイルにシートを3枚造って下さい。「メイン」「Q&A」「問題保管」の3枚です。
2.「Q&A」「問題保管」のシートの1行目にタイトルを入れます。A列から「正答回数」「誤答回数」「問題」「答1」「答2」「答3」で答の列は必要数作って頂いて結構です。
3.「Q&A」のシートに問題と正解を登録します。例えば、
  第3代京都府知事|北垣国道
  城南宮は○○が○○を造営する際に鎮守として祀られた|白河天皇|鳥羽殿
  上賀茂神社の神事(1月から)|競馬会神事|葵祭|烏相撲

4.標準モジュールに下記のコードを登録して下さい。

Sub メイン()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Worksheets("Q&A").Select
やり直し

Rowpos = 2
問題数 = 0

Do
If Cells(Rowpos, 3) <> "" Then
問題数 = 問題数 + 1
End If
Rowpos = Rowpos + 1

Loop While Rowpos <> Cells(Rows.Count, 3).End(xlUp).Row + 1

Rowpos = 2

Do

If Cells(Rowpos, 3) <> "" Then

回答 = ""
正解 = ""
正解数 = Cells(Rowpos, Columns.Count).End(xlToLeft).Column - 3

回答 = InputBox(Cells(Rowpos, 3), 問題数 & "問中" & Rowpos - 1 & "問目")

If 回答 = "" Then
Worksheets("メイン").Select
Exit Sub
End If

Colpos = 4
For i = 1 To 正解数
Select Case 正解数
Case 1
正解 = Cells(Rowpos, Colpos)
Case Else
正解 = 正解 & " " & Cells(Rowpos, Colpos)
Colpos = Colpos + 1
End Select

Next

If 回答 = LTrim(正解) Then
If Cells(Rowpos, 2) <> "" Then
If Cells(Rowpos, 2) > 0 Then
Cells(Rowpos, 2) = Cells(Rowpos, 2) - 1
If Cells(Rowpos, 1) <= 0 Then
Cells(Rowpos, 2) = ""
End If
Else
Cells(Rowpos, 2) = ""
End If
End If
Cells(Rowpos, 1) = Cells(Rowpos, 1) + 1
If Cells(Rowpos, 1) > 9 Then
If Cells(Rowpos, 2) = "" Then
問題保管へ移動 Rowpos
End If

End If
Rowpos = Rowpos + 1
Else
Cells(Rowpos, 2) = Cells(Rowpos, 2) + 1
MsgBox ("正解は" & LTrim(正解) & "/" & vbLf & 問題数 & "問中" & Rowpos - 2 & "問まで到着。やり直し。")
やり直し
Rowpos = 2
End If

Else
Exit Do
End If

Loop While Rowpos <> 問題数 + 2

If Rowpos = 問題数 + 2 Then
MsgBox ("全問正解!!" & vbLf & "全" & 問題数 & "問")
Worksheets("メイン").Select
End If

End Sub

Sub やり直し()

Columns("a").Select
Selection.Insert

Rowpos = 2

Do
If Cells(Rowpos, 4) <> "" Then
Cells(Rowpos, 1) = Int(10 * Rnd)
Rowpos = Rowpos + 1
Else
Rows(Rowpos).Delete
End If

Loop While Rowpos <> Cells(Rows.Count, 4).End(xlUp).Row + 1

Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select

ActiveWorkbook.Worksheets("Q&A").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Q&A").Sort.SortFields.Add Key:=Range("C2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Q&A").Sort.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Q&A").Sort
.SetRange Range("A2:M35")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("a").Select
Selection.Delete
Range("a1").Select

End Sub

Sub 問題保管へ移動(Rowpos)

Rows(Rowpos).Cut
Worksheets("問題保管").Select
Rows(Cells(Rows.Count, 3).End(xlUp).Row + 1).Select
ActiveSheet.Paste
Range("a1").Select
Worksheets("Q&A").Select

End Sub

注意
1.VBAは独学で趣味で学んだものなので、一般的な規則通りで無いかもしれません。
2.動作確認はエクセル2007で行っています。
3.何か障害が起きても責任は持てません。
4.バグを見つけ次第、常時修正しています。

関連記事
スポンサーサイト

テーマ:京都 - ジャンル:地域情報

2013.05.06 | | Comments(0) | Trackback(0) | 【検】チャレンジ!!京都検定

«  | HOME |  »

タイムライン

リンク


京都市 ブログランキングへ

にほんブログ村 地域生活(街) 関西ブログ 京都(市)情報へ
にほんブログ村

都の商売人様バナー
都の商売人様運営サイト
“空想の匣”

プロフィール

SOULKYOTO

Author:SOULKYOTO
東京生まれの東京育ち、でも魂は京都人
自称・勝手に京都観光大使

全記事表示リンク

全ての記事を表示する

カテゴリ

カレンダー

08 | 2017/09 | 10
- - - - - 1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30

検索フォーム

ブロとも申請フォーム

この人とブロともになる

QRコード

QR