Seite 3 von 3 ErsteErste 123
Ergebnis 51 bis 56 von 56
  1. Beitrag #51
    Admiral
    Special
    Admiral
    Avatar von Gruß Thomas!
    • Mein System
      Notebook
      Modell: Lenovo Thinkpad S440 Touch, 14" (1600x900), Core i7 4500u, HD8670M, 8GB RAM, 850 Evo 500GB
      Desktopsystem
      Prozessor: AMD Ryzen 7 1700
      Mainboard: Gigabyte AB-350 Gaming 3-CF
      Kühlung: AMD Wraith Spire (Übergangsweise)
      Arbeitsspeicher: 16GB Corsair Vengeance LPX DDR4 3200MHz @2933MHz
      Grafikkarte: 2GB Sapphire HD7870 (Stock)
      Display: 2 x LG 21.5"
      SSD(s): 256 Samsung, 256 Crucial M4
      Festplatte(n): Western Digital Caviar Black 1TB
      Gehäuse: Lian Li PC-A05NB
      Netzteil: Antec TruePowerNew 550
      Betriebssystem(e): Windows 10
      Browser: Google Chrome
      Sonstiges: http://www.sysprofile.de/id46649
      sysProfile: System bei sysProfile
    • Mein DC

      Gruß Thomas! beim Distributed Computing

      Aktuelle Projekte: Virtual Prairie, Docking@Home
      Lieblingsprojekt: QMC@Home, Virtual Prairie
      Rechner: FX8120
      BOINC-Statistiken:

    Registriert seit
    27.03.2008
    Ort
    Bayreuth
    Beiträge
    1.527
    Danke Danke gesagt 
    368
    Danke Danke erhalten 
    48
    Blog-Einträge
    9
    Mein aktuelles Projekt:

    Eine Hibernate Search Integration mit dem Ziel so viele JPA Varianten wie nur möglich zu unterstützen (mein Google Summer of Code Projekt):

    https://github.com/Hotware/Hibernate-Search-JPA

  2. Beitrag #52
    Admiral
    Special
    Admiral
    Avatar von Gruß Thomas!
    • Mein System
      Notebook
      Modell: Lenovo Thinkpad S440 Touch, 14" (1600x900), Core i7 4500u, HD8670M, 8GB RAM, 850 Evo 500GB
      Desktopsystem
      Prozessor: AMD Ryzen 7 1700
      Mainboard: Gigabyte AB-350 Gaming 3-CF
      Kühlung: AMD Wraith Spire (Übergangsweise)
      Arbeitsspeicher: 16GB Corsair Vengeance LPX DDR4 3200MHz @2933MHz
      Grafikkarte: 2GB Sapphire HD7870 (Stock)
      Display: 2 x LG 21.5"
      SSD(s): 256 Samsung, 256 Crucial M4
      Festplatte(n): Western Digital Caviar Black 1TB
      Gehäuse: Lian Li PC-A05NB
      Netzteil: Antec TruePowerNew 550
      Betriebssystem(e): Windows 10
      Browser: Google Chrome
      Sonstiges: http://www.sysprofile.de/id46649
      sysProfile: System bei sysProfile
    • Mein DC

      Gruß Thomas! beim Distributed Computing

      Aktuelle Projekte: Virtual Prairie, Docking@Home
      Lieblingsprojekt: QMC@Home, Virtual Prairie
      Rechner: FX8120
      BOINC-Statistiken:

    Registriert seit
    27.03.2008
    Ort
    Bayreuth
    Beiträge
    1.527
    Danke Danke gesagt 
    368
    Danke Danke erhalten 
    48
    Blog-Einträge
    9
    Zitat Zitat von Gruß Thomas! Beitrag anzeigen
    Mein aktuelles Projekt:

    Eine Hibernate Search Integration mit dem Ziel so viele JPA Varianten wie nur möglich zu unterstützen (mein Google Summer of Code Projekt):

    https://github.com/Hotware/Hibernate-Search-JPA
    Oh, ich hab die Anleitung, wie man das benutzt, leider vergessen:

    http://hibernatesearchandjpa.blogspo...arch-with.html

  3. Beitrag #53
    Commodore
    Special
    Commodore
    Avatar von Alyva
    • Mein System
      Desktopsystem
      Prozessor: AMD Athlon 64 3500+ Newcastle
      Mainboard: K8N SLI Platinum
      Kühlung: Boxed Variante
      Arbeitsspeicher: MDT 2* 1 GB PC400 CL2
      Grafikkarte: Geforce 6800 GT Ultra
      Display: 17" AOC 1280*1024
      Festplatte(n): WD 360 GD / ST3200822A
      Optische Laufwerke: Toshiba DVD-Rom SD-M1912
      Soundkarte: Soundblaster Audigy
      Netzteil: 380 Watt
      Betriebssystem(e): Windows XP
      Browser: Maxthon

    Registriert seit
    13.01.2008
    Beiträge
    473
    Danke Danke gesagt 
    2
    Danke Danke erhalten 
    0
    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
    °


  4. Beitrag #54
    Admiral
    Special
    Admiral
    Avatar von Gruß Thomas!
    • Mein System
      Notebook
      Modell: Lenovo Thinkpad S440 Touch, 14" (1600x900), Core i7 4500u, HD8670M, 8GB RAM, 850 Evo 500GB
      Desktopsystem
      Prozessor: AMD Ryzen 7 1700
      Mainboard: Gigabyte AB-350 Gaming 3-CF
      Kühlung: AMD Wraith Spire (Übergangsweise)
      Arbeitsspeicher: 16GB Corsair Vengeance LPX DDR4 3200MHz @2933MHz
      Grafikkarte: 2GB Sapphire HD7870 (Stock)
      Display: 2 x LG 21.5"
      SSD(s): 256 Samsung, 256 Crucial M4
      Festplatte(n): Western Digital Caviar Black 1TB
      Gehäuse: Lian Li PC-A05NB
      Netzteil: Antec TruePowerNew 550
      Betriebssystem(e): Windows 10
      Browser: Google Chrome
      Sonstiges: http://www.sysprofile.de/id46649
      sysProfile: System bei sysProfile
    • Mein DC

      Gruß Thomas! beim Distributed Computing

      Aktuelle Projekte: Virtual Prairie, Docking@Home
      Lieblingsprojekt: QMC@Home, Virtual Prairie
      Rechner: FX8120
      BOINC-Statistiken:

    Registriert seit
    27.03.2008
    Ort
    Bayreuth
    Beiträge
    1.527
    Danke Danke gesagt 
    368
    Danke Danke erhalten 
    48
    Blog-Einträge
    9
    Zitat Zitat von Alyva Beitrag anzeigen
    Bewundernswert, du bist wohl der einzige der hier überhaupt etwas macht
    Hehe, danke

    Zitat Zitat von Alyva Beitrag anzeigen
    Aber mal gefragt, hat dieses Projekt eine Zukunft?
    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

    Zitat Zitat von Alyva Beitrag anzeigen
    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
    Meinst du Haiku OS (https://www.haiku-os.org/)? OS Development ist momentan ehrlich gesagt momentan nicht mein Interessensgebiet.
    Geändert von Gruß Thomas! (09.07.2015 um 13:37 Uhr)

  5. Beitrag #55
    Lieutenant
    Lieutenant

    Registriert seit
    10.10.2014
    Beiträge
    90
    Danke Danke gesagt 
    0
    Danke Danke erhalten 
    1

    Excel-Anwendung für Glücksritter

    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.

    Klicke auf die Grafik für eine größere Ansicht 

Name:	tipeval.PNG 
Hits:	78 
Größe:	78,9 KB 
ID:	32902

    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 b3030, 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 = "$MS30" 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

  6. Beitrag #56
    Grand Admiral
    Special
    Grand Admiral
    Avatar von BoMbY
    • Mein System
      Desktopsystem
      Prozessor: Ryzen 3700X
      Mainboard: Gigabyte X570 Aorus Elite
      Kühlung: Noctua NH-U12A
      Arbeitsspeicher: 2x16 GB, G.Skill F4-3200C14D-32GVK @ 3600 16-16-16-32-48-1T
      Grafikkarte: RX 5700 XTX
      Display: Samsung CHG70, 32", 2560x1440@144Hz, FreeSync2
      SSD(s): Samsung 850 EVO 512GB, Samsung 840 EVO 1TB, Samsung 960 EVO 1TB
      Optische Laufwerke: Sony BD-5300S-0B (eSATA)
      Gehäuse: Phanteks Evolv ATX
      Netzteil: Enermax Platimax 750W
      Betriebssystem(e): Windows 10
      Browser: Firefox

    Registriert seit
    22.11.2001
    Ort
    Aachen
    Beiträge
    4.934
    Danke Danke gesagt 
    27
    Danke Danke erhalten 
    140
    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.
    @AMD: You could always send me an NDA and your prototypes, so I could test your new stuff for you, instead of searching for leaks about it.

Seite 3 von 3 ErsteErste 123

Berechtigungen

  • Neue Themen erstellen: Nein
  • Themen beantworten: Nein
  • Anhänge hochladen: Nein
  • Beiträge bearbeiten: Nein
  •