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
Ergebnis 51 bis 56 von 56
-
25.06.2015, 17:49 Beitrag #51 ↑
Special
- Registriert seit
- 27.03.2008
- Ort
- Bayreuth
- Beiträge
- 1.527
- Danke
- 368
- Danke
- 48
- Blog-Einträge
- 9
Come on. Let's do some Open-Source!
LuceneBeanExtension@git HotSound@git BlockBreaker@git BlockBreaker@Play
-
04.07.2015, 15:24 Beitrag #52 ↑
Special
- Registriert seit
- 27.03.2008
- Ort
- Bayreuth
- Beiträge
- 1.527
- Danke
- 368
- Danke
- 48
- Blog-Einträge
- 9
Oh, ich hab die Anleitung, wie man das benutzt, leider vergessen:
http://hibernatesearchandjpa.blogspo...arch-with.htmlCome on. Let's do some Open-Source!
LuceneBeanExtension@git HotSound@git BlockBreaker@git BlockBreaker@Play
-
06.07.2015, 00:05 Beitrag #53 ↑
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
°
-
06.07.2015, 03:37 Beitrag #54 ↑
Special
- Registriert seit
- 27.03.2008
- Ort
- Bayreuth
- Beiträge
- 1.527
- Danke
- 368
- Danke
- 48
- Blog-Einträge
- 9
Hehe, danke
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
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)
Come on. Let's do some Open-Source!
LuceneBeanExtension@git HotSound@git BlockBreaker@git BlockBreaker@Play
-
12.07.2015, 17:54 Beitrag #55 ↑
- Registriert seit
- 10.10.2014
- Beiträge
- 90
- Danke
- 0
- Danke
- 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.
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
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
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
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
-
15.06.2019, 20:23 Beitrag #56 ↑
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.