INAUD-Auswertungsroutine VBA

[Mike32]

Hier der gewünschte Quellcode zur Auswertung der INAUDI-Figur und des Spiegelbildes.

Am Anfang werden die Daten jedoch aus den Permanenztabellen eingelesen und in 14er-Blöcke entsprechend ausgewertet.

Will man keine Auswertung in 14er-Blöcken machen, sondern jeden Coup entsprechend auswerten (also Coup nach Coup), dann fügt man bei ´**** noch folgende Befehlszeile ein: tt=tt-13

Dim Testaus(14) As Integer

Public Ausreihe As Long

Sub Inaudi()

Ausreihe = 0

For t = 1 To 98

Sheets(t).Activate: Zähler = 0

For tt = 1 To 40000

temp = "A" + Mid((Str$(tt)), 2)

If IsEmpty((Worksheets(Sheets(t).Name).Range(temp).Value)) = True Then Exit For

Zähler = Zähler + 1

temp = Worksheets(Sheets(t).Name).Range(temp).Value

´ Wenn eine 0 vorkommt, ist der Block ungültig.

If temp = 0 Then

Zähler = 0

GoTo wei

End If

´Auswertung nach R/S

If temp = 1 Or temp = 3 Or temp = 5 Or temp = 7 Or temp = 9 Or temp = 12 Or temp = 14 Or temp = 16 Or temp = 18 Or temp = 19 Or temp = 21 Or temp = 23 Or temp = 25 Or temp = 27 Or temp = 30 Or temp = 32 Or temp = 34 Or temp = 36 Then 'Rot

Testaus(Zähler) = 1

Else

Testaus(Zähler) = 2

End If

´ Nun Auswerten, ob überhaupt die Inaudi-Figur vorliegt

If Zähler = 14 Then

´****

Zähler = 0: Flag2 = 0: Flag1 = 0

If Testaus(1) = 1 And Testaus(2) = 2 And Testaus(3) = 2 And Testaus(4) = 2 And

Testaus(5) = 2 And Testaus(6) = 1 And Testaus(7) = 1 And Testaus(8) = 1 And Testaus(9) = 1 And Testaus(10) = 2 And Testaus(11) = 2 And Testaus(12) = 2 Then

´Wenn ja, nun Auswertung der Coups 13 und 14

If Testaus(13) = 1 Then

Flag1 = 1

Else

Flag1 = -1

If Testaus(14) = 2 Then

Flag2 = 1

Else

Flag2 = -1

End If

End If

´ Nunr Eintrag des Auswerteergebnisses in Tabelle “Auswertung”.

Ausreihe = Ausreihe + 1

temp = "A" + Mid((Str$(Ausreihe)), 2)

Worksheets("Auswertung").Range(temp).Value = Sheets(t).Name

temp = "B" + Mid((Str$(Ausreihe)), 2)

Worksheets("Auswertung").Range(temp).Value = Flag1

temp = "C" + Mid((Str$(Ausreihe)), 2)

Worksheets("Auswertung").Range(temp).Value = Flag2

End If

´Hier nochmals das Gleiche, aber diesmal für die Spiegelfigur

If Testaus(1) = 2 And Testaus(2) = 1 And Testaus(3) = 1 And Testaus(4) = 1 And

Testaus(5) = 1 And Testaus(6) = 2 And Testaus(7) = 2 And Testaus(8) = 2 And Testaus(9) = 2 And Testaus(10) = 1 And Testaus(11) = 1 And Testaus(12) = 1 Then

If Testaus(13) = 2 Then

Flag1 = 1

Else

Flag1 = -1

If Testaus(14) = 1 Then

Flag2 = 1

Else

Flag2 = -1

End If

End If

Ausreihe = Ausreihe + 1

temp = "A" + Mid((Str$(Ausreihe)), 2)

Worksheets("Auswertung").Range(temp).Value = Sheets(t).Name

temp = "B" + Mid((Str$(Ausreihe)), 2)

Worksheets("Auswertung").Range(temp).Value = Flag1

temp = "C" + Mid((Str$(Ausreihe)), 2)

Worksheets("Auswertung").Range(temp).Value = Flag2

End If

End If

wei:

Next tt

Next t

Grüße

Mike32

bearbeitet März 11, 2005 von Mike32

[Wenke]

@Mike32

Danke für den Quelltext.

Es ist ganz interessant, welchen Code andere verwenden.

Bei der Übername des Quellcodes ich sehe nur ein Problemchen:

Es werden verschiedene Blätter aktiviert und Permanezen eingelesen.

Die Namen, müssen wie im Modul geschrieben sein, da können leicht Fehler gemacht werden.

Auch beim Einlesen der Perm können sich leicht Fehler einschleichen.

Ist es dir möglich eine komplette Arbeitsmappe einzustellen?

Beste Grüße

Wenke

[Mike32]

@ Wenke

die gesamte Arbeitsmappe ist leider ca. 19,8 MB groß. Klappt daher leider nicht.

Aber ich könnte den Anfang der Routine wie folgt beschreiben:

Die 98 Permanenz-Arbeitstabellen haben zwar alle einen Namen z.B. GLPL01-00, aber intern sind sie von Excel automatisch durchnummeriert. Von daher nimmt die Routine zuerst die 1. Arbeitstabelle, wählt sie aus und fängt dann mit den dort enthaltenen Zahlen an diese in Spalte A von oben nach unten einzulesen. Ist die Spalte A leer (Befehl isempty), dann wird der ggf. bestehende Angriff abgebrochen und die nächste Arbeitstabelle wird ausgewählt. Dann beginnt wieder alles von vorne.

In dieser Schleife "hänge" ich dann immer die jeweilige Auswertelogik.

Nur wenn das Ergebnis eines Angriffes feststeht, wird die Ergebnis-Arbeitstabelle explizit ausgewählt "Auswertung" und dann wird dort das Ergebnis eingetragen. Danach wird die zuletzt verwendete Arbeitstabelle ausgewählt und es geht wieder weiter.

Grüße

Mike32

[Wenke]

Hallo Mike32

Danke für deine schnelle Antwort.

Klar, bei dieser Menge an Permanenzen ist die Arbeitsmappe zum Einstellen zu groß.

Zum Verständnis genügen jedoch ein, zwei Permanenztage. Sie müssten noch nicht einmal sehr lang sein.

Den Rest erledigt dann dein Programm.

Das müsste vielleicht doch zu machen sein.

Beste Grüße

Wenke

[Mike32]

@ Wenke,

nimm doch einfach eine CC oder eine HH-Permanenz, dann hast du doch Originalwerte.

grüße

Mike32

[Mike32]

@ Wenke,

vergaß noch zu erwähnen, dass du einfach eien neue Arbeitsmappe anlegen brauchst. In die 1. Tabelle (Wichtig!!) kommen in Spalte A senkrecht die auszuwertenden Coups. Diese Tabelle (und nur diese!) kann auch umbenannt werden.

Die 2. Tabelle wir umbenannt in "Auswertung" (ohne "). Die Routine wird in ein neu angelegtes VBA-Modul kopiert und los geht es (also VBA-Routine starten).

Die Ergebnisse erscheinen in "Auswertung"

Grüße

Mike32

[Revanchist]

@Mike 32

@ Wenke

wie wird denn eine VBA-Routine gestartet ?

Habe den Code in MS Visual Basic eingegeben und dann ?

Noch ne Frage am Rande: wie legt man einen Code auf einen neuen Button?

Thanks vorneweg

Ciao der

Revanchist

[Mike32]

@ Revanchist

o.k. hier die Antworten

Der Code wird angelegt, indem man auf "Extras- Makro - Visual-Basic Editor" geht. Man kann aber auch ganz einfach Alt+F11 drücken.

Dann erscheint ein neues, dreigeteiltes Fenster. Im obeneren linken Teil steht fett "VBA-Project (Mappe1)" (wenn neue Mappe angelegt wurde). Das klickt man einmal an, drückt die rechte Maustaste, geht auf Einfügen im Context-Menü und wählt Modul.

Nun erscheint rechts ein leeres "Blatt". Dort kann man nun den Code eingeben/kopieren.

Das mit dem Button wird wie folgt erledigt. Nachdem du den Code eingegeben hast, speicherst du die Mappe einmal ab und beendest den Editor.

Nun gehst du mit der Maus oben auf die/irgendeine Buttonleiste der Mappe (nicht auf ein Button klicken!!), drückst die rechte Maustaste und gehst beim Kontext-Menü auf "Anpassen...". In dem nun erscheinenden Fenster, klickst du auf die Karteikarte "Befehle", gehst im linken Teil auf Makros, nimmst im rechten Fenster eine "Benutzerdefinierte Schaltfläche"(nicht Menüelement !!), klickst sie mit der Maus an, hälst die Taste gedrückt, schiebst den Button auf auf eine Leiste an die Stelle, wo du den Knopf haben willst und läßt die Maustaste los. Wenn du nun auf den neuen Button einmal klickst und die rechte Maustaste betätigst, dann kannst du den Knopf entsprechend benennen und konfigurieren.

Das war's

Grüße

Mike32

bearbeitet März 14, 2005 von Mike32

[Revanchist]

@Mike 32

Danke vorab.

bin zur Zeit unterwegs und habe keine Zeit es auszuprobieren. Werde dies aber in Kürze machen.

Tschüss

der Revanchist