Hallo! Wo ist der Feher? Wenn ich mir das auswerfen lassen möchte so funktioniert alles, aber dann bleibt alles hängen (Wenn ich die varainz und den erwartungswert berechnen möchte)? Könnt ihr mir weiterhelfen?
Option Explicit
Public Sub Eingabe()
Dim Eingabe As Variant
Dim Zahl As Integer
Zahl = 0
'Ausgabe der Messagebox mit Zahlen zwischen 50 und 1000, sonst Fehlermeldsung"
Do
Eingabe = Application.InputBox(prompt:="Anzahl der simulierenden Klausuren")
If VarType(Eingabe) = vbBoolean Then Exit Do
If Eingabe <= 1000 And Eingabe >= 50 Then
MsgBox "Ihre Zahl: " & Eingabe, vbOKOnly, "Information"
Exit Do
End If
MsgBox "Fehler! Nur Zahlen zwischen 50 und 1000!", 16, "Warnung"
Loop
'Schleife
Do While Zahl < Eingabe
Zahl = Zahl + 1
Cells(Zahl, 1).Value = Int((100 + 1) * Rnd)
Loop
' Message zur Abfgrage des Stichprobenumfangs
Do
Eingabe = Application.InputBox(prompt:="Wie groß ist Ihr Stichprobenumfang bei 10.000 Klausren")
If VarType(Eingabe) = vbBoolean Then Exit Do
If Eingabe <= 6000 And Eingabe >= 1000 Then
MsgBox "Ihre Zahl: " & Eingabe, vbOKOnly, "Information"
Exit Do
End If
MsgBox "Fehler! Die Stichprobe darf nur zwischen 1000-6000 Klausren liegen!!", 16, "Warnung!"
Loop
'Variablen für das Kopieren
Dim Anzahl As Double
Dim Zaehler2 As Integer
Dim Zaehler3 As Integer
Dim Puffer As Integer
Dim Prüfer As Boolean
Dim Liste(10000) As Integer
Dim Summe(6001) As Long
Dim Stichprobe
Dim ProzentAnzahl
Zaehler2 = 0
Anzahl = Anzahl * Stichprobe / 100
'Prüfen ob bereits vorhanden und Kopieren
Do While Zaehler2 <= ProzentAnzahl
Zaehler3 = 0
Zaehler2 = Zaehler2 + 1
Prüfer = True
Liste(Zaehler2) = Rnd * Anzahl
Puffer = Liste(Zaehler2)
Do While Zaehler3 < Zaehler2
If Puffer = Liste(Zaehler3) Then Prüfer = False
Zaehler3 = Zaehler3 + 1
Loop
If Prüfer = True Then Cells(Zaehler2, 3) = Cells(Liste(Zaehler2), 1)
If Prüfer = True Then Summe(Zaehler2) = Cells(Liste(Zaehler2), 1).Value
If Prüfer = False Then Zaehler2 = Zaehler2 - 1
Loop
'Erwartungswert
Dim Summe2 As Double
Dim Erwartungswert As Integer
Summe2 = WorksheetFunction.Sum(Range("C:C"))
Erwartungswert = Summe2 / Anzahl
Columns("E:E").ColumnWidth = 16
Cells(2, 5).Value = "Erwartungswert:"
Cells(2, 6).Value = Erwartungswert
'Varianz
Dim Varianz As Double
Dim Quadratsumme As Double
Dim Zaehler4 As Integer
Zaehler4 = 1
Do While Zaehler4 <= ProzentAnzahl
Summe(Zaehler4) = ((Summe(Zaehler4) - Erwartungswert) ^ 2)
Zaehler4 = Zaehler4 + 1
Loop
Quadratsumme = WorksheetFunction.Sum(Summe)
Varianz = Quadratsumme / (ProzentAnzahl - 1)
Cells(3, 5).Value = "Varianz:"
Cells(3, 6).Value = Varianz
End Sub
|