Excel(エクセル)実用編：百ます計算の作成

• Excel(エクセル)での百ます計算(かけ算)の問題作成と、採点をVBAで行うものを作成してみました。

使用する関数と機能

• 使用する関数：RAND()　RANK　OFFSET

完成例(VBAで作成したもの)　　　サンプル：hyaku.xls

• 出題ボタンをクリックすると問題が表示されます。
• 【答え合わせ】ボタンで、正解は緑、不正解は赤文字に変化し得点が表示されます。
  • 

考え方　　　Topへ

• 0〜9の数字をランダムに並べるには？
  • RAND()関数で乱数を10個発生させ、10この乱数にRANK関数で0〜9と順位を付けます。
  • Sheet2のA2セルとC2セルにに=RAND()と入力し、下方向へコピーします。
    B2セルに=RANK(A2,$A$2:$A$11)-1、D2セルに=RANK(C2,$C$2:$C$11)-1と入力し、下方向へコピーします。
    
• Sheet1のB2セルに=OFFSET(Sheet2!$B$2,COLUMN(A1)-1,0)と入力し、右方向へK2セルまでコピーします。
• Sheet1のA3セルに=OFFSET(Sheet2!$D$2,ROW(A1)-1,0)と入力し、下方向へA12セルまでコピーします。
  
• これで問題は作成でき、[F9]キーを押して再計算するたびに問題が変更されます。
• しかし、答えを入力するとExcelは自動で再計算するため問題が変更されてしまいます。
  [ツール]→[オプション]の計算方法で「手動」にしておくのも一案ですがちょっと使い勝手が悪いです。
• よって、VBAで作成することにします。

VBAで作成する　　　Topへ

出題用のVBA コードの作成　　　Topへ

• Sheet2のA2〜A11とC2〜C11に乱数を発生させます。VBAではRnd()を使います。
• Sheet2のB2〜B11とD2〜D11にRANK関数を使った数式を入力します。
• Sheet1のB2:K2とA3:A12にOFFSET関数でSheet2の順位を参照する式を入力します。
• 答えの欄B3:K13の値をクリアし、フォントの色を黒に設定します。
• 入力時に問題を改変しないように、スクロールエリアを入力範囲B3:K12に固定します。
  解除は「scroll_kaijyo」を実行します。
  

  Sub hyaku() 　Dim i As Integer 　　With Sheets("Sheet2") 　　　　For i = 1 To 10 　　　　　　Randomize 　　　　　　.Cells(i + 1, 1).Value = Rnd() 　　　　　　Randomize 　　　　　　.Cells(i + 1, 3).Value = Rnd() 　　　　Next i 　　　　.Range("B2:B11").Formula = "=RANK(A2,$A$2:$A$11)-1" 　　　　.Range("D2:D11").Formula = "=RANK(C2,$C$2:$C$11)-1" 　　End With 　　With Sheets("Sheet1") 　　　　.Range("B3:K13").ClearContents 　　　　.Range("B3:K13").Font.ColorIndex = 1 　　　　.Range("B2:K2").Formula = "=OFFSET(Sheet2!$B$2,COLUMN(A1)-1,0)" 　　　　.Range("A3:A12").Formula = "=OFFSET(Sheet2!$D$2,ROW(A1)-1,0)" 　　　　.ScrollArea = "B3:K12" 　　End With End Sub Sub scroll_kaijyo() 　　’スクロールエリアの解除 　　Sheets("Sheet1").ScrollArea = "" End Sub

答え合わせのコードの作成　　　Topへ

• For〜Nextで計算し、入力された値が正しいかを検査します。
  正しい時はフォントの色を緑にし、カウントをしていきます。
  不正解の時はフォントの色を赤にします。
• ここで注意するのは、未入力の状態と「0」の区別をしています。
  「If .Cells(i + 2, j + 1).Value <> "" And _」の部分です。
• 得点は正解のカウント数をメッセージボックスで表示しています。
  

  Sub kotae() 　Dim i As Integer 　Dim j As Integer 　Dim myCount As Integer 　　myCount = 0 　　With Sheets("Sheet1") 　　　　For j = 1 To 10 　　　　　　For i = 1 To 10 　　　　　　　　If .Cells(i + 2, j + 1).Value <> "" And _ 　　　　　　　　　　.Cells(i + 2, j + 1).Value = .Cells(2, j + 1).Value * .Cells(i + 2, 1).Value Then 　　　　　　　　　　.Cells(i + 2, j + 1).Font.ColorIndex = 4 　　　　　　　　　　myCount = myCount + 1 　　　　　　　　Else 　　　　　　　　　　.Cells(i + 2, j + 1).Font.ColorIndex = 3 　　　　　　　　End If 　　　　　　Next i 　　　　Next j 　　End With 　　MsgBox "得点は　" & myCount & "点です" End Sub

　PageViewCounter
　
　Since2006/2/27