Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Bewerten Sie hier bitte das Excel-Portal

Home Zurück Vor

Download Beispiel-Arbeitsmappe

Thema

Abfrage von Rechenaufgaben zeitgesteuert nach dem Zufallsprizip

Gruppe

TextBox

Problem

Wie kann ich zeitgesteuert Rechenaufgaben abfragen. Die Basiszahlen und die Operanden sollen durch das Zufallsprinzip bestimmt und die Ergebnisse sollen ausgewertet werden.

Lösung

Geben Sie den nachfolgenden Code in das Klassenmodul der UserForm ein.

StandardModule: basMain

Public NextTime As Date

Sub CallForm()
   frmRechnen.Show
End Sub

Sub Verbergen()
   Worksheets("Memory").Visible = xlVeryHidden
End Sub

Sub NeueAufgabe()
   Dim vOperand As Variant
   Dim iOperand As Integer, iFactorA As Integer, iFactorB As Integer
   Dim iRowL As Integer
   Dim sOperand As String
   Randomize
   vOperand = Array("+", "-", "*", "/")
   iOperand = Int((4 * Rnd) + 0)
   sOperand = vOperand(iOperand)
   iFactorA = Int((99 * Rnd) + 1)
   iFactorB = Int((9 * Rnd) + 1)
   frmRechnen.lblAufgabe.Caption = iFactorA & " " & sOperand & " " & iFactorB
   Worksheets("Memory").Range("AA1").Formula = "=" & frmRechnen.lblAufgabe.Caption
   NextTime = Now + TimeSerial(0, 0, frmRechnen.SpinButton1.Value)
   Application.OnTime _
      earliesttime:=NextTime, _
      procedure:="NeueAufgabe"
End Sub

Sub RechnenBeenden()
   On Error GoTo ERRORHANDLER
   Application.OnTime _
      earliesttime:=NextTime, _
      procedure:="NeueAufgabe", _
      schedule:=False
ERRORHANDLER:
   With Worksheets("Memory")
      If WorksheetFunction.CountA(.Columns(1)) = 0 Then Exit Sub
      MsgBox "Von " & WorksheetFunction.CountA(.Columns(1)) & _
         " Aufgaben wurden " & WorksheetFunction.Sum(.Columns(1)) & _
         " richtig gelöst." & vbLf & _
         "Dies entspricht " & Format(WorksheetFunction.Sum(.Columns(1)) / _
         WorksheetFunction.CountA(.Columns(1)), "0.0%")
         .Columns(1).ClearContents
   End With
End Sub

ClassModule: frmRechnen

Private Sub cmdContinue_Click()
   Unload Me
   Call RechnenBeenden
End Sub

Private Sub cmdLoesung_Click()
   Dim iRow As Integer
   If txtLoesung.Text = "" Then Exit Sub
   With Worksheets("Memory")
      iRow = WorksheetFunction.CountA(.Columns(1)) + 1
      If CDbl(txtLoesung.Text) = .Range("AA1").Value Then
         .Cells(iRow, 1).Value = 1
      Else
         .Cells(iRow, 1).Value = 0
      End If
   End With
   txtLoesung.Text = ""
   txtLoesung.SetFocus
End Sub

Private Sub cmdStart_Click()
   Call NeueAufgabe
End Sub

Private Sub SpinButton1_Change()
   Label4.Caption = SpinButton1.Value & " sec."
End Sub

Private Sub UserForm_Initialize()
   SpinButton1.Value = 10
End Sub