Eigene Programmvorstellungen und fertige Codeschnipsel...

Bewundernswert, du bist wohl der einzige der hier überhaupt etwas macht :) Aber mal gefragt, hat dieses Projekt eine Zukunft? Abgesehen davon, bei deinem Einsatz hier hätte ich dich gerne mal beim Haiku-Projekt gesehen. Aber das ist zugegebener maßen auch wieder eine andere Hausnummer. Wie auch immer, viel Erfolg weiterhin :)
 
Alyva schrieb:
Bewundernswert, du bist wohl der einzige der hier überhaupt etwas macht :)
Zum Vergrößern anklicken....

Hehe, danke :)

Alyva schrieb:
Aber mal gefragt, hat dieses Projekt eine Zukunft?
Zum Vergrößern anklicken....

Definitiv. Der Plan ist, dass Teile davon in die originale Hibernate Search Engine übernommen werden, bzw. das Projekt unter Umständen in die Hibernate Projektfamilie übernommen wird (mit dem Project Lead von Hibernate Search besprochen, dieser ist mein Mentor bei Google Summer of Code). Wie das genau passieren wird, wird sich noch zeigen :)

Alyva schrieb:
Abgesehen davon, bei deinem Einsatz hier hätte ich dich gerne mal beim Haiku-Projekt gesehen. Aber das ist zugegebener maßen auch wieder eine andere Hausnummer. Wie auch immer, viel Erfolg weiterhin :)
Zum Vergrößern anklicken....

Meinst du Haiku OS (https://www.haiku-os.org/)? OS Development ist momentan ehrlich gesagt momentan nicht mein Interessensgebiet. :)
 
Zuletzt bearbeitet:
Vielleicht gibt es ja den einen oder anderen hier, der gelegentlich mal sein Glück versucht, besonders wenn der Jackpot mal hoch ist, und dann und wann mal einen Tipschein ausfüllt. Dann erhält man man einen Kontroll-Bon mit den getippten Reihen. Nach erfolgter Ziehung kann man diesen Bon natürlich in der Tip-Stelle kontrollieren lassen. Besser ist es jedoch, wenn man das selbst tut, erstens, damit man weiß, ob da vielleicht etwas auf einen zukommt, und zweitens, weil sich so ein optisches Auslesegerät in der Tipstelle ja auch mal irren könnte.
Das manuelle Kontrollieren eines solchen Tip-Bons ist eine beschwerliche Sache und zudem natürlich auch Fehler-anfällig, weil schließlich ja auch optisch. Wahrscheinlich gibt es schon einen Haufen Tip-(Kontroll-)Programme, man könnte so ein Programm aber selber basteln. Dazu eignet sich natürlich mal wieder die Auswertungsallzweckwaffe Excel. Dazu kann man seine Tipreihen wie abgebildet eintragen.

tipeval.PNG

Es handelt sich hierbei um die Abbildung von Tippscheinen für die Lotterie Eurojackpot.
Ich bin davon ausgegangen, dass Gelegenheitstipper höchstens mal zwei Scheine ausfüllen, wenn der Jackpott mal sehr hoch. Aber natürlich könnte man noch sehr viel mehr Scheine in Excel abbilden, so ein Arbeitsblatt ist ziemlich lang. Der hier gezeigte Aufbau im Arbeitsblatt ist wie folgt:

Zeile 1 zeigt zur Orientierung die tipbaren Zahlen, im ersten block die Hauptzahlen (1 bis 50), im zweiten Block die Zusatzzahlen (1 bis 10)
Zeile 2 zeigt, wie häufig eine Zahl über alle getätigten Tip-Reihen des darunter folgenden Tipscheins hinweg getipt wurde
Zeile 3 bis 12 zeigen die getippten Zahlen, dabei stellt der Eintrag einer "1" in ein Feld den Tip der entsprechenden Zahl oben dar (zur Markierung wird hier aus technischen Gründen die Zahl "1" verwendet und nicht etwa zb. der Buchstabe "X")
Zeile 13 zeigt wie Zeile 2 die Häufigkeit einer jeden getippten Zahl über alle Reihen des wiederum darunter folgenden Tipscheins hinweg
Zeile 14 bis 23 der zweite Tipschein
Zeile 24 wiederum zur leichteren Orientierung die tipbaren zahlen
Zeile 25 die Gesamtvorkommnisse der getipten Zahlen über die Tipreihen beider Scheine hinweg
Zeile 30 die beiden Felder zum Eintragen der tatsächlich gezogenen 5 Haupt- und 2 Zusatzzahlen
Zeile 33 wiederum die tipbaren Zahlen zur besseren Sichtbarkeit
Zeile 34 die absolute Häufigkeit der (ab einem bestimmten Datum) tatsächlich gezogenen Zahlen (dazu später noch was)

nun zu den Spalten:
Spalte A: zeigt in den Zeilen 3 bis 12 und 14 bis 23 einfach die Nummern der Tipreihen der beiden abgebildeten Scheine, zur besseren Orientierung,
die beiden hellgrün hinterlegten Zellen in den Zeilen 2 und 13 sind zwei Schalter-Zellen, über die die Art der Auswertung des jeweiligen Scheins gesteuert werden kann, daher sind in beiden Zellen nur bestimmte Zahlenwerte zulässig: in a2 0 = werte diesen schein nicht aus, 1 = werte den ganzen Schein aus, 11 = werte die erste Hälfte des Scheins aus und 12 = werte die zweite Hälfte des Scheins aus.
Und entsprechend für die Zelle a13 die Zahlenwerte 0, 2, 21 und 22. Der Wert 0 darf allerdings nicht gleichzeitig in beiden Zellen vorkommen, denn das würde ja heißen: werte nichts aus, was keinen Sinn macht. Das Programm verhindert also, dass diese beiden Zellen zugleich 0 werden.
Spalte B bis AY enthalten die getippten Zahlen
Spalte AZ enthält in
Zeile 2 einen Kontrollwert: wenn ein ganzer Schein ausgefüllt ist mit 10 Reihen zu jeweils 5 getippten Hauptzahlen, dann müssen, sofern nichts übersehen wurde, hier 50 als Ergebnis der Vollständigkeitskontrolle stehen, bei einem halben ausgefüllten Schein entsprechend 25
Zeilen 3 bis 12 und 14 bis 23 enthalten die Auswertung der Tipscheine, nachdem das Ziehungsergebnis eingetragen wurde: schwarze 0 = kein Treffer in dieser Reihe, rote Zahl > 0 = entsprechende Trefferzahl in dieser Reihe
Spalte BA bis BJ enthalten die getippten beiden Zusatzzahlen, auch wiederum aus technischen Gründen jeweils mit "1" markiert
Spalte BK dasselbe wie AZ hier für die beiden Zusatzzahlen, also Vollständigkeitskontrolle in Zeilen 2 und 13, die übrigen Zeilen mit der Auswertung

Soweit zum Aufbau der Tabelle. Wie wird das Blatt nun bedient?
1. Zunächst einmal Tipreihen in die dazu vorgesehen Blöcke für die Haupt- bzw. Zusatzzahlen einzutragen, indem die Zellen der Tips jeweils mit einer "1" versehen wird.
2. Nach der Ziehung der Zahlen werden diese Ergebniszahlen in die dafür vorgesehenen Felder B30 bis O30 wie abgebildet eingetragen.
3. Ausserdem sind die beiden Werte in die Steuerungszellen a2 und a13 einzutragen.
Die Programmstruktur sorgt dafür, dass die Reihenfolge der Schritte 2. und 3. unerheblich ist. Sind alle benötigten Werte eingegeben, führt das Programm die Auswertung automatisch durch.
Was ist das Ergebnis des Programms?
Das Programm liefert zwei Ergebnisse, die optisch etwas aufbereitet werden. Zum einen wird die Anzahl der Treffer einer jeden Tipreihe als Summe kumuliert ausgegeben in den besagten Spalten AZ und BK. Summen größer Null werden zur besseren Erkennbarkeit Bold und Rot ausgegeben. Ausserdem werden die Zellen in den Tip-Blöcken, die einen Treffer darstellen, mit kräftig gelbem Hintergrund versehen.
Zweitens werden die Häufigkeiten der Ergebniszahlen sukzessive von Ziehung zu Ziehung aufsummiert und nach jeder Ziehung die fünf häufigsten Hauptzahlen sowie die zwei häufigsten Zusatzzahlen mit hellgelbem Hintergrund hervorgehoben. Selbstverständlich ist die Wahrscheinlichkeit der zuerst gezogenen Hauptzahl ein Fünzigstel, der zweiten Zahl ein Neunundvierzigstel usw., soweit das Ziehungsgerät einen hinreichend perfekten Zufallsgenerator realisiert. Dies vorausgesetzt muss es demzufolge so sein, dass die hier aufgezeichneten absoluten Häufigkeiten sich auf sehr lange Sicht angleichen. Das nach jeder Ziehung gezeigte Zwischenergebnis der Häufigkeitsverteilung zeigt also lediglich einen sozusagen historischen Moment
dieses Angleichungsprozesses, aus welchem sich, sofern das Ziehungsgerät ein echter Zufallsgenerator ist, keine gültigen Schlüsse in Hinblick auf die nächste Ziehung ableiten lassen.

Wie ist das Programm technisch realisiert?
Geschrieben mittels der Entwicklungsumgebung von Excel 2007 in VBA. Dem groben Aufbau nach besteht das Programm aus einem Modul, in dem übergreifende, an sich selbständige Funktionen untergebracht sind, sowie zwei Arbeitsblatt-bezogenen Code-Teilen.
Das Modul besteht aus der Auswertungsroutine sub tipeval(), einer Routine sub tftrmfn(), die die fünf häufigsten Hauptziehungszahlen bzw. die zwei häufigsten Zusatzziehungszahlen ermittelt, und einer Sortierfunktion sortarn(ar()) für numerische Werte. Der erste Arbeitsblatt-bezogene Code-Teil befindet sich in "DieseArbeitsmappe", wird ausgelöst durch das Workbook_open Event und bewirkt nur, dass die Steuerungszellen a2 und a13 beide
auf den Wert 0 gesetzt werden sowie der Cursor auf die erste Zelle des Ziehungsergebnis-Eingabefeldes gesetzt wird.

Code: 
Private Sub Workbook_Open()
    '
    'default wert = 0 für worksheets(1)cells(2, 1) und .cells(13, 1) setzen und beim start des blattes b30 aktivieren
    Application.EnableEvents = False
    With Worksheets(1)
        .Cells(2, 1).Value = 0
        .Cells(13, 1).Value = 0
        '
        .Cells(30, 2).Activate
    End With
    Application.EnableEvents = True
    '
End Sub

Der zweite Arbeitsblatt-bezogene Code-Teil steckt im (ersten) Arbeitsblatt namens "Tips". Dieser wird ausgelöst durch das Workbook_Change Event. Aber natürlich nicht durch ein beliebiges Änderungsereignis an diesem Arbeitsblatt. Vielmehr definieren sich die relevanten Ereignisse durch einige der oben erwähnten Eingaben, die der User zur Bedienung des Arbeitsblattes tätigt. Der User gibt zum einen seine Tipreihen ein und speichert sie. Das hat noch keine Folgen. Erst wenn die Bedienung des Arbeitsblattes korrekt abgeschlossen wurde, soll die Folge eintreten, dass das Arbeitsblatt ausgewertet wird auf Richtigkeit der Tippreihen.
Dieser Code kontrolliert also, ob die korrekten Voraussetzungen für eine Auswertung erfüllt sind. Sind sie erfüllt, löst dieser Code wiederum die eigentlichen Auswertungsroutinen aus, die in dem Modul stecken.
Welches sind die Voraussetzungen für eine Auswertung? Zum einen muss dem Programm über die beiden Steuerungszellen a2 und a13 mitgeteilt werden, welche Teile der ausgefüllten Scheine auszuwerten sind. Wird dies vergessen, so macht das Programm entsprechend darauf aufmerksam. Eine Auswertung kann zudem nur ausgelöst werden, wenn nicht beide Steuerungszellen 0 sind.
Dann ist es natürlich erforderlich, dass ein neues Ziehungsergebnis eingetragen wird.
Sind diese Voraussetzungen, gleichgültig in welcher zeitlichen Reihenfolge sie wahr werden, erfüllt, dann löst das Programm die Auswertung der Tippreihen (anhand des eingegebenen Ziehungsergebnisses) aus. Logisch gesehen erfordert die Auswertung also die Erfüllung folgender Bedingung:
{(z1=7) or [(z1>0) and (z1<7)]} and {[((p1=1) or (p1=11) or (p1=12)) or ((p2=0) or (p2=2) or (p2=21) or (p2 =22))] or [((p1=0) or (p1=1) or (p1=11) or (p1=12)) and ((p2=2) or (p2=21) or (p2=22))]}

Aufgrund der Eigenschaft von User-Eingaben notwendigerweise eine zeitliche Reihenfolge zu haben, ging es programmtechnisch also darum, das Workbook_Change Event zu bändigen. Dieses Ereignis wird nämlich z.B. schon dann ausgelöst, wenn eine einzelne Zelle irgendwie geändert wird. Die Eingabe der Ziehungszahlen besteht aber schon aus der Änderung von 7 Zellen. Also muss man das Workbook_Change Ereignis irgendwie veranlassen zu warten auf das Eintreten eines Tupels von Bedingungen.
Erschwerend kommt hinzu, dass es denkbar ist, dass der User weniger als 7 Zahlen im Ziehungsergebnisfeld einzugeben hat, etwa weil zufällig eine Ziehungszahl an der Stelle, an der sie schon beim letzten Ergebnis stand, nun auch beim neuen Ergebnis steht, oder weil der User ein bisschen rumspielen will. Daher kann die Eingabe von 7 neuen Ergebniszahlen nicht notwendige Bedingung für die Auslösung der Auswertung sein. Dieses Teilproblem ist dahingehend gelöst, dass die Workbook_Change Event-Routine den Aufenthalt des Cursors bei der Eingabe des Ziehungsergebnisses kontrolliert. Verlässt der Cursor den Bereich b30:o30, so wird das so interpretiert, dass der User die Eingabe beenden will. Daher wird der User entsprechend gefragt, ob dies zutrifft. Negiert der User, kann er anschließend nahtlos mit der Eingabe weitermachen. Umgekehrt lernt der User so, dass er durch eine entsprechende Cursorbewegung einfach vorzeitig eine Auswertung auslösen kann, soweit die sonstigen Bedingungen erfüllt sind.
Auch kann es vorkommen, dass sich der User bei der Eingabe der Ziehungszahlen vertut. Also muss es möglich sein, dass der User mehr als die gewöhnlich notwendigen 7 Zahlen als Ziehungsergebnis eingeben können muss, ohne dass bei der 7. Änderung, in einem solchen Fall vorschnell, die Auswertung ausgelöst wird. Auch dieses Problem ist durch einen kleinen Kniff gelöst. Dazu wird die statische Zählervariable z1 durch weitere Zell-spezifisch reagierende Zähler am Weiterzählen gehindert für den Fall von Mehrfachänderungen an derselben Zelle. Durch die dadurch erreichte Gruppierung der Änderungen kann die Gesamtheit der effektiven Änderungen die Zahl 7 nicht überschreiten.
Ferner muss gewährleistet sein, dass einerseits eine sowohl korrekte als auch sinnvolle Eingabenkombination in beiden Steuerungszellen erfolgt, und dass andererseits die alleinige Änderung einer der beiden Zellen zwar schon das Workbook_Change Ereignis auslöst, aber noch nicht die Auswertung auslösen soll. Da Ereignisse quasi singulär und daher naturgemäß vergesslich sind, muss auch hier mit statischen variablen gearbeitet werden, welche ein Ereignis überleben.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    'kontrolliert zwei steuerungszellen, die festlegen, welche scheine wie überprüft werden, und ein zusammengesetztes ergebniszahlenfeld
    'und entscheidet anhand gewisser kriterien, ob eine berechnung durchgeführt werden soll und durchgeführt werden kann
    'auswertung wird ausgelöst wenn:
    '{(z1=7) or [(z1>0) and (z1<7)]} and {[((p1=1) or (p1=11) or (p1=12)) or ((p2=0) or (p2=2) or (p2=21) or (p2 =22))] or [((p1=0) or (p1=1) or (p1=11) or (p1=12)) and ((p2=2) or
    '(p2=21) or (p2=22))]}
    '
    's1>0 ((eingabe ergebniszahlenfeld trotz z1 < 7 abgeschlossen) oder (z1 = 0)), i.e. berechnung soll erfolgen, aber a2 und a13 beide 0
    's2>0 a2 und a13 korrekt zur berechnung vorbereitet, aber noch keine ergebniszahleneintragung erfolgt
    Static s1 As Integer, s2 As Integer
    'z6 zähler korrekte a2 eingabe
    Static z6 As Integer
    'z7 zähler korrekte a13 eingabe
    Static z7 As Integer
    'za1 bis za7 address-bezogene Änderungszähler
    Dim za1 As Integer, za2 As Integer, za3 As Integer, za4 As Integer, za5 As Integer, za6 As Integer, za7 As Integer
    '
    'variablen zur a2 und a13 überwachung
    '------------------------------------
    'die zellen a2 (1, 11, 12) und a13 (2, 21, 22) auf eingabe der zulässigen werte überwachen
    'inhalt der beiden Zellen wird tipeval als parameter übergeben, zweck: steuert ob/welche scheine wie (halb/voll/gar nicht) berechnet werden
    Dim p1 As Range
    Dim p2 As Range
    '
    With Worksheets(1)
        Set p1 = .Cells(2, 1)
        Set p2 = .Cells(13, 1)
    End With
    '
    'variablen ergebniszahlenbereich-überwachung
    '-------------------------------------------
    'target cells
    Dim tc As Range
    'target areas, durch verwendung des gesamten bereichs wird die abfrage der cursorposition nach einer änderung obsolet
    Dim ta As Range
    'Dim acr As Integer
    'Dim acc As Integer
    'aufgrund static anweisung bleibt variable nach ende der prozedur erhalten, auf diese weise wird korrekt hochgezählt über (beliebig viele) change_events hinweg
    Static z1 As Integer
    'messagebox-return
    Dim mbr1 As Integer
    'target-cells für monitoring der änderungen, target-area für monitoring der cursor-position
    Set tc = Range("B30, D30, F30, H30, J30, M30, O30")
    Set ta = Range("B30:O30")
    '
    '
    'überwachung von a2 und a13 zur steuerung der auswertungsweise
    '-------------------------------------------------------------
    If Not Intersect(Target, p1) Is Nothing Then
        If Not ((p1.Value = 0) Or (p1.Value = 1) Or (p1.Value = 11) Or (p1.Value = 12)) Then
            '
            Application.EnableEvents = False
            '
            p1.Value = 0
            MsgBox ("Nur 0, 1, 11 oder 12 zulässig in dieser Zelle.")
            p1.Activate
            Application.EnableEvents = True
        ElseIf ((p1.Value = 0) Or (p1.Value = 1) Or (p1.Value = 11) Or (p1.Value = 12)) Then
            'reaktion auf (cursor nach änderung außerhalb ta, ((berechnung: ja) oder (z1 = 7)), aber a2,a13 beide 0)
            'z6+ = korrekte eingabe in a2
            z6 = z6 + 1
            '
            If z7 = 0 Then
                'wenn p1 = 0 muss a13 geändert werden
                If p1.Value = 0 Then
                    MsgBox ("A13 muss geändert werden.")
                    p2.Activate
                Else
                    mbr1 = MsgBox("A13 auch ändern?", vbYesNo)
                    If mbr1 = vbNo Then
                        If s1 > 0 Then
                            's1 > 0 = eine ergebnisfeldeingabe wurde geändert und ((es soll auf nachfrage berechnet werden obwohl z1 < 7) oder (z1 = 7))
                            'wenn nein, s1, z6-7 zurücksetzen, berechnung starten
                            z1 = 0
                            s1 = 0
                            z6 = 0
                            z7 = 0
                            Call tipeval(p1.Value, p2.Value)
                        Else
                            s2 = s2 + 1
                            [b30].Activate
                        End If
                    Else
                        'wenn ja noch keine berechnung und cursor auf a13
                        p2.Activate
                    End If
                End If
            ElseIf z7 > 0 Then
                'z7>0, p2 = 0,2,21,22
                If p2.Value = 0 Then
                    If p1.Value = 0 Then
                        MsgBox ("Kein Auswertungsauftrag vorhanden.")
                        p2.Activate
                    Else
                        'p1>0
                        If s1 > 0 Then
                            z1 = 0
                            s1 = 0
                            z6 = 0
                            z7 = 0
                            Call tipeval(p1.Value, p2.Value)
                        Else
                            s2 = s2 + 1
                            [b30].Activate
                        End If
                    End If
                Else
                    'p1>0, p2>0, berechnen
                    If s1 > 0 Then
                        z1 = 0
                        s1 = 0
                        z6 = 0
                        z7 = 0
                        Call tipeval(p1.Value, p2.Value)
                    Else
                        s2 = s2 + 1
                        [b30].Activate
                    End If
                End If
            End If
        End If
    End If
    '
    If Not Intersect(Target, p2) Is Nothing Then
        If Not ((p2.Value = 0) Or (p2.Value = 2) Or (p2.Value = 21) Or (p2.Value = 22)) Then
            Application.EnableEvents = False
            p2.Value = 0
            MsgBox ("Nur 0, 2, 21 oder 22 zulässig in dieser Zelle.")
            p2.Activate
            Application.EnableEvents = True
        ElseIf ((p2.Value = 0) Or (p2.Value = 2) Or (p2.Value = 21) Or (p2.Value = 22)) Then
            'reaktion auf (cursor nach änderung außerhalb ta, ((berechnung: ja) oder (z1 = 7)), aber a2,a13 beide 0)
            'z7+ = korrekte eingabe in a13
            z7 = z7 + 1
            '
            If z6 = 0 Then
                If p2.Value = 0 Then
                    MsgBox ("A2 muss geändert werden.")
                    p1.Activate
                Else
                    'z6 = 0, p2 > 0
                    mbr1 = MsgBox("A2 auch ändern?", vbYesNo)
                    If mbr1 = vbNo Then
                        'wenn nein, s1, z6-7 zurücksetzen, berechnung starten
                        If s1 > 0 Then
                            's1 > 0 = eine ergebnisfeldeingabe wurde geändert und ((es soll auf nachfrage berechnet werden obwohl z1 < 7) oder (z1 = 7))
                            z1 = 0
                            s1 = 0
                            z6 = 0
                            z7 = 0
                            Call tipeval(p1.Value, p2.Value)
                        Else
                            s2 = s2 + 1
                            [b30].Activate
                        End If
                    Else
                        'wenn ja noch keine berechnung und cursor auf a2
                        p1.Activate
                        'dort kann wiederum 0 oder >0 eingegeben werden
                    End If
                End If
            ElseIf z6 > 0 Then
                'wenn z6>0, ie. p1 nach: 0 oder 1,11,12
                If p1.Value = 0 Then
                    If p2.Value = 0 Then
                        MsgBox ("Kein Auswertungsauftrag vorhanden.")
                        'also nach p1 bzw. a2 gehen und z6 zurücksetzen (i.e. bei p1 wurde letztgültig noch nichts eingestellt)
                        'z6 = 0
                        p1.Activate
                        '
                    Else
                        'wenn p2>0
                        If s1 > 0 Then
                            z1 = 0
                            s1 = 0
                            z6 = 0
                            z7 = 0
                            Call tipeval(p1.Value, p2.Value)
                        Else
                            s2 = s2 + 1
                            [b30].Activate
                        End If
                    End If
                Else
                    'wenn p1>0
                    If s1 > 0 Then
                        z1 = 0
                        s1 = 0
                        z6 = 0
                        z7 = 0
                        Call tipeval(p1.Value, p2.Value)
                    Else
                        s2 = s2 + 1
                        [b30].Activate
                    End If
                End If
            End If
        End If
    End If
    '
    '
    'überwachung ergebniszahlenbereich
    '---------------------------------
    'wenn änderung im zielbereich, z1 hochzählen
    If Not Intersect(Target, tc) Is Nothing Then
        'z1 hochzählen, dabei mehrfachänderungen an derselben addresse unberücksichtigt lassen
        If Target.Address = "$B$30" Then
            If za1 = 0 Then
                za1 = za1 + 1
                z1 = z1 + 1
                [d30].Activate
                '
            End If
        ElseIf Target.Address = "$D$30" Then
            If za2 = 0 Then
                za2 = za2 + 1
                z1 = z1 + 1
                [f30].Activate
            End If
        ElseIf Target.Address = "$F$30" Then
            If za3 = 0 Then
                za3 = za3 + 1
                z1 = z1 + 1
                [h30].Activate
            End If
        ElseIf Target.Address = "$H$30" Then
            If za4 = 0 Then
                za4 = za4 + 1
                z1 = z1 + 1
                [j30].Activate
            End If
        ElseIf Target.Address = "$J$30" Then
            If za5 = 0 Then
                za5 = za5 + 1
                z1 = z1 + 1
                [m30].Activate
            End If
        ElseIf Target.Address = "$M$30" Then
            If za6 = 0 Then
                za6 = za6 + 1
                z1 = z1 + 1
                [o30].Activate
            End If
        ElseIf Target.Address = "$O$30" Then
            If za7 = 0 Then
                za7 = za7 + 1
                z1 = z1 + 1
            End If
        End If
        '
        'entscheidung zur auswertung treffen
        '-----------------------------------
        If z1 < 7 Then
            If Intersect(ActiveCell, ta) Is Nothing Then
                'solange z1 < 7, wenn sich die aktive zelle nach der änderung außerhalb ta befindet
                mbr1 = MsgBox("Ist die Eingabe beendet?", vbYesNo)
                If mbr1 = vbYes Then
                    '
                    s1 = s1 + 1
                    'bevor tipeval aufgerufen wird müssen die angaben zur anzahl und weise scheine vorhanden sein
                    If Not (s2 > 0) Then
                        MsgBox ("Kein Auswertungsauftrag in A2 oder A13 vorhanden.")
                        p1.Activate
                        '
                    Else
                        'z1 zurücksetzen und auswertung anstossen
                        z1 = 0
                        s2 = 0
                        z6 = 0
                        z7 = 0
                        Call tipeval(p1.Value, p2.Value)
                    End If
                End If
            End If
        ElseIf z1 = 7 Then
            '
            s1 = s1 + 1
            'bevor tipeval aufgerufen wird müssen die angaben zur anzahl und weise scheine vorhanden sein
            If Not (s2 > 0) Then
                MsgBox ("Kein Auswertungsauftrag in A2 oder A13 vorhanden.")
                p1.Activate
                '
            Else
                'z1 zurücksetzen und auswertung anstossen
                z1 = 0
                s2 = 0
                z6 = 0
                z7 = 0
                Call tipeval(p1.Value, p2.Value)
            End If
        End If
    End If
    '
End Sub

Sind die Bedingungen zur Auswertung erfüllt, wird die Auswertungsroutine tipeval aufgerufen. Bevor das Ergebnis der Auswertung in die Tabelle geschrieben wird, muss die Tabelle vom vorherigen Auswertungsergebnis gesäubert werden. Das betrifft die Hintergrundfarbe in den Tipp-Blöcken, die Hintergrundfarbe bei der Häufigkeitsverteilung (aber nicht die Zahlen dieser Verteilung, denn diese werden ja aufsummiert), sowie die Zahlen und Fontfarben in den Auswertungsergebnisblöcken, die gelöscht bzw. zurückgesetzt werden müssen. Ist dies erledigt, beginnt die eigentliche Auswertung, deren Ergebnisse wiederum in die entsprechenden Ergebnisblöcke (Spalten AZ und BK geschrieben werden). Ergebnisse sowie die Trefferstellen werden
entsprechend wieder farblich hervorgehoben.

Code: 
Sub tipeval(ByVal par1 As Variant, ByVal par2 As Variant)
    'überprüft die scheine an den ergebniszahlen nach deren eingabe
    'für einen jeden schein kann festgelegt werden, ob er hälftig, und wenn ja, welche hälfte, oder ob er zur gänze ausgewertet wird
    'dies wird über die beiden parameter, die die zellen a2 und a13 auswerten, gesteuert
    'es werden (auf nachfrage) die absoluten ergebniszahlen-häufigkeiten geführt bzw. aktualisiert
    'die prozedur tftrmfn, die dies erledigt, macht ihrerseits von einer (aufsteigenden) sortierfunktion sortarn (für eindimensionale arrays) gebrauch
    '
    'die übergebenen parameter auswerten, sind die beiden zellen a2 oder a13 nicht manuell anders gesetzt, wird der default-wert 0 übergeben
    'demnach kann übergeben werden par1: 0,1,11,12 und par2: 0,2,21,22 und nicht gleichzeitig par1 und par2 gleich 0
    'ie. ist nicht mindestens eine der beiden zellen auf einen anderen wert als 0 gesetzt, wird keine berechnung angestossen
    '
    'performance verbessern
    Application.ScreenUpdating = False
    'blatt aktivieren
    Worksheets("Tips").Activate
    'event-detecting abschalten
    Application.EnableEvents = False
    '
    'blatt aufräumen
    '---------------
    'vor neuberechnung zellen mit farbigem hintergrund in einem bestimmten bereich finden und zurücksetzen auf weiß oder grau, je nach zeile
    Dim r1 As Range
    Dim sc1 As Variant
    'als suchkriterium der farbigen hintergründe dient ein Zellinhalt "1", der für diesen Fall notwendig koinzidiert
    sc1 = 1
    Dim loc1 As String
    Dim e0 As Integer
    Dim a1 As Integer, a2 As Integer, a3 As Integer, a4 As Integer
    'suchbereich festlegen, ein geschlossener bereich b3:bj23 funktioniert nicht: bei schein2 gilt nicht gerade=weiss, ungerade=grau, sondern umgekehrt
    'einzelbereiche sind:
    'b3:ay12 (.cells(3, 2), .cells(12, 51))
    'ba3:bj12 (.cells(3, 53), .cells(12, 62))
    'b14:ay23 (.cells(14, 2), .cells(23, 51))
    'ba14:bj23 (.cells(14, 53), .cells(23, 62))
    '
    For e0 = 1 To 4
        If (e0 = 1) Or (e0 = 2) Then
            a1 = 3
            a3 = 12
        End If
        If (e0 = 3) Or (e0 = 4) Then
            a1 = 14
            a3 = 23
        End If
        If (e0 = 1) Or (e0 = 3) Then
            a2 = 2
            a4 = 51
        End If
        If (e0 = 2) Or (e0 = 4) Then
            a2 = 53
            a4 = 62
        End If
        With Worksheets(1).Range(Worksheets(1).Cells(a1, a2), Worksheets(1).Cells(a3, a4))
            Set r1 = .Find(what:=sc1, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, searchformat:=False)
            '
            If Not r1 Is Nothing Then
                'erste Fundstelle merken
                loc1 = r1.Address
                Do
                    'setzt den colorindex der gefundenen zelle alternierend je nach gerader oder ungerader zeile auf den der betreffenden zeile entsprechenden colorindex
                    'interior.colorindex: ungerade:grau=2 , gerade:weiss=-4142; interior.color: gerade 4,3: 16777215 ; ungerade 3,3: 15921906
                    'hintergrundfarbe zurücksetzen geht auch mit interior.colorindex = xlColorIndexNone
                    '
                    If (r1.Row) Mod 2 = 0 Then
                        If e0 < 3 Then
                            r1.Interior.Color = 16777215
                        ElseIf e0 > 2 Then
                            r1.Interior.Color = 15921906
                        End If
                    ElseIf (r1.Row) Mod 2 <> 0 Then
                        If e0 < 3 Then
                            r1.Interior.Color = 15921906
                        ElseIf e0 > 2 Then
                            r1.Interior.Color = 16777215
                        End If
                    End If
                    '
                    Set r1 = .FindNext(r1)
                Loop While ((Not r1 Is Nothing) And (r1.Address <> loc1))
            End If
        End With
    Next e0
    '
    Set r1 = Nothing
    '
    '
    'vom vorherigen prg-durchlauf evtl. vorhandene überprüfungsergebnisse löschen(, farb-änderungen im font zurücksetzen)
    With Range("AZ3:AZ12, AZ14:AZ23, BK3:BK12, BK14:BK23")
        .Select
        Selection.Font.ColorIndex = 1
        Selection.Font.Bold = False
        Selection.ClearContents
    End With
    'letzte selection aufheben und excel-cursor stattdessen nach a26 setzen
    [a26].Activate
    '
    '
    'scheine berechnen
    '-----------------
    'e1 laufvariable für ergebniszahlen-array
    Dim e1 As Integer
    'e2 laufvariable für spalten
    Dim e2 As Integer
    'e3 laufvariable für zeilen
    Dim e3 As Integer
    'e4 laufvariable für steuerungsschleife
    Dim e4 As Integer
    'e4 steuerungsvariablen u und v
    Dim u As Integer
    Dim v As Integer
    'e3 steuerungsvariablen w und x
    Dim w As Integer
    Dim x As Integer
    'z4 zähler für treffer
    Dim z4 As Long
    z4 = 0
    'falls kein Treffer erzielt wurde, wird 0 gespeichert
    'msgbox-return
    Dim mbr1 As Integer
    '
    'e4 steuerungskriterien
    If par1 <> 0 Then
        u = 1
    Else
        u = 2
    End If
    If par2 <> 0 Then
        v = 2
    Else
        v = 1
    End If
    '
    For e4 = u To v
    'daraus resultiert (u=1 und v=2) oder (u=1 und v=1) oder (u=2 und v=2)
        'steuerungsschleife für anzahl der gesamtdurchläufe, ie. anzahl der scheine
        '
        'e3 steuerungskriterien für die auszuwertenden reihen
        'e4 kann nur zwei werte annehmen: 1 oder 2
        If e4 = 1 Then
            If par1 = 1 Then
                w = 3
                x = 12
            ElseIf par1 = 11 Then
                w = 3
                x = 7
            ElseIf par1 = 12 Then
                w = 8
                x = 12
            End If
        ElseIf e4 = 2 Then
            If par2 = 2 Then
                w = 14
                x = 23
            ElseIf par2 = 21 Then
                w = 14
                x = 18
            ElseIf par2 = 22 Then
                w = 19
                x = 23
            End If
        End If
        '
        'Überprüfung der fünf Grundzahlen
        '--------------------------------
        With Worksheets(1)
            For e3 = w To x
                'durchlaufe die zeilen (tippreihen), beginnend bei zeile w (3) bis zeile x (12) (schein 1)
                For e2 = 2 To 51
                'durchlaufe die zahlenmöglichkeiten, beginnend bei spalte 2 ("B") bis 51 ("AY")
                    For e1 = 2 To 10 Step 2
                    'durchlaufe die ergebniszahlen, beginnend mit spalte 2 = B bis spalte 6 = F, geht bis spalte J!!, muss im step + 2 gehen
                        If .Cells(1, e2).Value = .Cells(30, e1).Value Then
                        'stellt fest, ob eine zahl gezogen wurde
                        'wenn der wert in zelle zeile 1, spalte z2 (beginnend mit B, endend mit AY) identisch dem wert in zelle z1 (beginnend mit B, endend mit F), zeile 24 ist, dann
                            '
                            If .Cells(e3, e2) = 1 Then
                            'stellt fest, ob diese gezogene Zahl getippt wurde
                            'wenn zelle zeile e3, spalte e2
                            '= "X" wird so nicht erkannt, = 1 schon !!
                                z4 = z4 + 1
                                'zählt die Treffer pro Tip
                                'den treffer hintergrund einfärben
                                .Cells(e3, e2).Interior.ColorIndex = 44
                            End If
                        End If
                    Next e1
                    '
                Next e2
                '
                .Cells(e3, 52) = z4
                If .Cells(e3, 52).Value > 0 Then
                    With .Cells(e3, 52).Font
                        .ColorIndex = 3
                        .Bold = True
                    End With
                End If
                'schreibt die Treffer pro Tip in Spalte AZ
                z4 = 0
                'setzt z4 nach durchlauf der Tippreihe und speichern des ergebnisses zurück
            Next e3
        End With
        '
        'Überprüfung der zwei Zusatzzahlen
        '---------------------------------
        z4 = 0
        e1 = 0
        e2 = 0
        e3 = 0
        '
        With Worksheets(1)
            For e3 = w To x
                For e2 = 53 To 62
                    For e1 = 13 To 15 Step 2
                        If .Cells(1, e2).Value = .Cells(30, e1).Value Then
                            If .Cells(e3, e2).Value = 1 Then
                                z4 = z4 + 1
                                .Cells(e3, e2).Interior.ColorIndex = 44
                            End If
                        End If
                    Next e1
                Next e2
                .Cells(e3, 63) = z4
                If .Cells(e3, 63).Value > 0 Then
                    With .Cells(e3, 63).Font
                        .ColorIndex = 3
                        .Bold = True
                    End With
                End If
                z4 = 0
            Next e3
        End With
        '
    Next e4
    '
    'ergebniszahlenhäufigkeiten aktualisieren auf nachfrage, wodurch testdurchläufe unberücksichtigt bleiben können
    '(da der häufigkeitsverlauf ohne speicherung der jeweiligen ergebniszahlen nicht rekonstruierbar ist)
    mbr1 = MsgBox("Ergebniszahlen-Häufigkeiten aktualisieren?", vbYesNo)
    If mbr1 = vbYes Then
        tftrmfn
    End If
    '
    'event-detecting ein
    Application.EnableEvents = True
    'screenupdating ein
    Application.ScreenUpdating = True
    '
End Sub

Schliesslich ruft die Auswertungsroutine auf Nachfrage die Routine zur Ermittlung der Häufigkeitsverteilung und farblichen Hervorhebung der häufigsten Ziehungszahlen auf. Auf Nachfrage deshalb, weil so Tests ermöglicht werden ohne dass dadurch die reale historisch ereignete Häufigkeitsverteilung in Mitleidenschaft gezogen würde. Diese Routine wiederum ruft die Sortierfunktion sortarn(ar()) auf. Dies ist eine Funktion, die eine aufsteigende Reihenfolge von numerischen Werten herstellt, welche sich in einem eindimensionalen array befinden. Die Funktion liefert auch wieder einen array zurück. Diese Funktion benutzt keinen rekursiven quicksort-algorithmus und auch keinen rekursiven oder iterativen bubblesort-algorithmus.

Code: 
Sub tftrmfn()
    'the five, two respectively, most frequent numbers
    'wird nach der auswertung durch tipeval aufgerufen
    'die prozedur generiert die absoluten häufigkeitswerte von ergebniszahlenvorkommnissen und trägt ein jedes solches vorkommnis in b34:ay34 bzw. ba34:bj34 ein,
    'und zwar nach jeder erneuten eingabe von ergebniszahlen
    'die in den beiden bereichen vorhandenen häufigkeiten werden in die arrays ar1 bzw. ar2 gelesen und die zahlen jeweils nach grösse aufsteigend durch
    'die funktion sortarn sortiert zurückgegeben
    'die letzten 5 bzw 2 elemente der arrays sind die fünf bzw. zwei häufigsten, diese werden dann in den obigen bereichen gesucht, der hintergrund der
    'vorkommnisse dieser zahlen farbig markiert
    'prüfen ob gleiche häufigkeiten vorkommen nötig? nein, gleiche häufigkeiten gelten als eine häufigkeit, daher kann es, insbesondere in der anfangsphase der
    'führung der häufigkeitsverteilung vorkommen, dass insgesamt mehr als 5 zellen markiert werden, weil mehrere zellen denselben häufigkeitswert aufweisen,
    'dies ist gewollt, sonst müssten willkürlich einige vorkommnisse derselben häufigkeit herausgenommen werden
    '
    Dim e2 As Integer, e1 As Integer, e3 As Integer
    Dim z1 As Integer
    Dim n As Integer, m As Integer
    Dim ar1() As Integer, ar2() As Integer
    Dim r2 As Range
    Dim loc2 As String
    Dim sc2 As Variant
    '
    'hintergrundfarbe der zuvor häufigsten zahlen zurücksetzen auf weiss
    Worksheets(1).Range("b34:ay34, ba34:bj34").Select
    Selection.Interior.ColorIndex = xlColorIndexNone '-4142
    [a26].Activate
    '
    'bereich b34:by34
    '----------------
    With Worksheets(1)
        'generierung der absoluten häufigkeitswerte
        For e2 = 2 To 51
            For e1 = 2 To 10 Step 2
                If .Cells(33, e2).Value = .Cells(30, e1) Then
                    'vermerkt ein jedes ergebniszahlenvorkommnis via inkrement (+1) in der korrespondierenden zelle der zeile 34
                    .Cells(34, e2).Value = .Cells(34, e2).Value + 1
                End If
            Next e1
        Next e2
        'einlesen der häufigkeiten in ein array ar1
        For e2 = 2 To 51
            If Not IsEmpty(.Cells(34, e2)) Then
                z1 = z1 + 1
                If (Not ar1) = -1 Then
                    ReDim ar1(z1 - 1)
                ElseIf Not (Not ar1) Then
                    ReDim Preserve ar1(z1 - 1)
                End If
                ar1(z1 - 1) = .Cells(34, e2).Value
            End If
        Next e2
    End With
    'ar1 sortieren
    ar1 = sortarn(ar1)
    'da sortarn aufsteigend sortiert, laufweite der suchschleife (e3) so festlegen, dass, wenn ar1 mehr als 5 bzw. 2 zahlen enhält, nur die letzten 5 bzw. 2 zahlen
    'berücksichtigt werden:
    n = UBound(ar1)
    'wenn ar1 weniger als 5 elemente hat, soll die such-schleife beim ersten element beginnen
    If n < 4 Then
        m = 0
    Else
        'wenn ar1 nicht weniger als 5 elemente hat, beginnt die such-schleife beim ubound(ar1)-4 ten element, so dass die letzten 5 elemente berücksichtigt werden
        m = n - 4
    End If
    'such-schleife, die die relevanten elemente von ar1 abarbeitet, evtl. doppelt vorkommende elemente werden via .findnext berücksichtigt
    With Worksheets(1).Range("b34:ay34")
        For e3 = m To n
            sc2 = ar1(e3)
            Set r2 = .Find(what:=sc2, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, searchformat:=False)
            If Not r2 Is Nothing Then
                loc2 = r2.Address
                Do
                    r2.Interior.ColorIndex = 19
                    Set r2 = .FindNext(r2)
                Loop While ((Not r2 Is Nothing) And (r2.Address <> loc2))
            End If
        Next e3
    End With
    Set r2 = Nothing
    '
    'dasselbe mit dem bereich ba34:bj34
    '----------------------------------
    'die letzten zwei elemente des array sind die zwei häufigsten
    With Worksheets(1)
        For e2 = 53 To 62
            For e1 = 13 To 15 Step 2
                If .Cells(33, e2).Value = .Cells(30, e1) Then
                    .Cells(34, e2).Value = .Cells(34, e2).Value + 1
                End If
            Next e1
        Next e2
        For e2 = 53 To 62
            If Not IsEmpty(.Cells(34, e2)) Then
                z1 = z1 + 1
                If (Not ar2) = -1 Then
                    ReDim ar2(z1 - 1)
                ElseIf Not (Not ar2) Then
                    ReDim Preserve ar2(z1 - 1)
                End If
                ar2(z1 - 1) = .Cells(34, e2).Value
            End If
        Next e2
    End With
    'ar2 sortieren
    ar2 = sortarn(ar2)
    'ubound von ar1 prüfen, wenn < 1, dann schleife bis ubound, >= 1 dann schleife bis 1, welche die letzten bis zu 2 zahlen-elemente herausnimmt
    'diese bis zu zwei zahlen dann im bereich ba34:bj34 suchen und farbig hinterlegen
    n = UBound(ar2)
    If n < 1 Then
        m = 0
    Else
        m = n - 1
    End If
    With Worksheets(1).Range("ba34:bj34")
        For e3 = m To n
            sc2 = ar2(e3)
            Set r2 = .Find(what:=sc2, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False, searchformat:=False)
            If Not r2 Is Nothing Then
                loc2 = r2.Address
                Do
                    r2.Interior.ColorIndex = 19
                    Set r2 = .FindNext(r2)
                Loop While ((Not r2 Is Nothing) And (r2.Address <> loc2))
            End If
        Next e3
    End With
    Set r2 = Nothing
End Sub
'
'
Function sortarn(ByRef ar() As Integer) As Integer()
    'sortierfunktion (aufsteigend) für numerisches eindimensionales array
    'funktion erwartet ein integer-array als paramter und gibt auch ein integer-array zurück,
    'die return-variable der aufrufenden prozedur sollte daher in einem dynamischen array bestehen
    '
    'für die erste zahl des zu sortierenden array gibt es im sortierten array eine mögliche position: die erste position
    'für die zweite zahl gibt es zwei mögliche positionen: die erste position oder die letzte position
    '-im ersten fall array um eine stelle erweitern und gesamten inhalt um eine position nach rechts schieben, davorsetzen
    '-im zweiten fall array erweitern und anhängen
    'für die nachfolgenden zahlen gibt es jeweils drei mögliche positionen: die erste, die letzte oder eine zu ermittelnde position x dazwischen
    '-im letzten fall array erweitern und den teil des array ab der position x nach rechts schieben, einfügen an x
    '
    If UBound(ar) = 0 Then
        sortarn = ar()
        Exit Function
    End If
    '
    Dim ar2() As Integer
    Dim e1 As Integer, e2 As Integer, e3 As Integer, e4 As Integer
    Dim n As Integer
    '
    ReDim ar2(0)
    ar2(0) = ar(0)
    For e1 = (LBound(ar) + 1) To (UBound(ar))
        For e2 = 0 To (UBound(ar2))
            If ar(e1) < ar2(e2) Then
                ReDim Preserve ar2(UBound(ar2) + 1)
                For e3 = (UBound(ar2) - 1) To 0 Step -1
                    ar2(e3 + 1) = ar2(e3)
                Next e3
                ar2(0) = ar(e1)
                Exit For
            ElseIf Not (ar(e1) < ar2(e2)) Then
                For e3 = 0 To (UBound(ar2))
                    If ar(e1) > ar2(e3) Then
                        n = e3
                    End If
                Next e3
                If n = UBound(ar2) Then
                    ReDim Preserve ar2(UBound(ar2) + 1)
                    ar2(UBound(ar2)) = ar(e1)
                Else
                    ReDim Preserve ar2(UBound(ar2) + 1)
                    For e4 = (UBound(ar2) - 1) To (n + 1) Step -1
                        ar2(e4 + 1) = ar2(e4)
                    Next e4
                    ar2(n + 1) = ar(e1)
                End If
                Exit For
            End If
        Next e2
    Next e1
    sortarn = ar2()
End Function
 
Nicht das hier noch viel los wäre, aber vielleicht findet das ja hier noch jemand interessant:

Ryzen Instruction Monitor: https://github.com/iBoMbY/RIM

Ein simples C# .NET Beispielprogramm das mit Hilfe von Performance Monitor Counters (PMC) verschiedene Arten von Instruktionen auf Ryzen CPUs pro CPU Thread zählt.
 

Ähnliche Themen

Dr@
Fujitsu STYLISTIC Q572 mit AMD Z-60 APU
Antworten
0
Aufrufe
53K
Dr@
Dr@
J
German Engineering - Nanoxia Deep Silence 1
Antworten
0
Aufrufe
22K
Jörg Heptner
J
Dr@
Download VLC media player 2.0 "Twoflower"
Antworten
5
Aufrufe
5K
cologne46
cologne46
J
Enermax Fulmo Advanced
Antworten
0
Aufrufe
15K
Jörg Heptner
J
Nero24
Intel 510 250 GB SSD-Review
Antworten
0
Aufrufe
35K
Nero24
Nero24
Zurück
Oben Unten