Thema Datum  Von Nutzer Rating
Antwort
Rot WO ist der Fehler?
15.11.2016 19:28:53 Simon Franke
NotSolved
15.11.2016 19:52:36 Gast39424
**
NotSolved

Ansicht des Beitrags:
Von:
Simon Franke
Datum:
15.11.2016 19:28:53
Views:
860
Rating: Antwort:
  Ja
Thema:
WO ist der Fehler?

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

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot WO ist der Fehler?
15.11.2016 19:28:53 Simon Franke
NotSolved
15.11.2016 19:52:36 Gast39424
**
NotSolved