Quellcode in Excel-VBA von Sudoku-Muff v0.93 REV 1
' -----------------------------------------------------------------------------------------------------------------
' - selbstgestricktes Sudoku-Lösungsprogramm V0.93 - (c) 01/2010-02/2010 by Magmuffa Philissog - www.Issog.com -
' - REV 1 -
' - Christian Gossmann (FÜR NICHT KOMMERZIELLE ZWECKE!) -
' -----------------------------------------------------------------------------------------------------------------
' - -
' - ddd --- ddd - Stellen beinhalten Debug-Code, der an der entsprechenden Stelle nützlich sein könnte (Ausgabe) -
' - -
' - xxx --- xxx - Stellen müssen an lokale Gegebenheiten angepasst werden -
' - -
' - yyy --- yyy - Stellen beinhalten Verbesserungsvorschläge -
' - -
' - zzz --- zzz - Stellen beinhalten Warnungen und / oder bekannte Fehler -
' - -
' -----------------------------------------------------------------------------------------------------------------
' Entwicklungsgeschichte u. Bugfixes (=wichtigste Erweiterungen u. Änderungen):
' aktuell: v0.93 REV 1
' --------------------
' v0.93 REV 1: Blattschutz (ohne Passwort) gesetzt, damit eben nicht sofort die Strukturen überschrieben werden
' kleinere Anpassungen wegen dem Blattschutz an den Makros vorgenommen
' außer dem Wikipedia-Samurai-Sudoku die anderen zwecks besserer Übersichtlichkeit hinausgeworfen
' v0.93 REV 0: bessere Angabenprüfung (mind. 17 Angaben, kein leeres Angabenfeld)
' Lösungsversuchsanzahl wird angezeigt beim Backtracing (kann aber auskommentiert werden, damit das Lösungs-Geschwindigkeit bringt)
' Symbolleiste in Excel für Lösung und Löschung, aut. Tastenzuweisung
' automatischer Abbruch bei Überschreitung d. max. Lösungsanzahl erfolgt jetzt (davor musste man. STRG-Untbr. gedrückt werden, was ohne Hinweis Endlosschleife bedeutete)
' Bugfix f. weitere falsche Hervorhebung fehlerhafter Angaben in Arealen (Abbruch hat aber auch in Vorversion weiterhin korrekt gearbeitet)
' v0.92BETA REV A: Gesamtlöschroutine für Angaben- u. Lösungsfeld samt allfälligen Hervorhebungen
' Bugfixing f. Buchstabenangabe in Arealen - es konnte eine falsche Zahl hervorheben werden -> neuer Fehler: bei illegalen Zahlen wurde dann nur 1 hervorgehoben (behoben in Nachfolgeversion)
' v0.92BETA : Ausgabenroutinen verbessert (=nicht überall ausgeben lassen, sondern nur am Ende und als Debug-Code deklariert -> kann bei Bedarf eingebunden werden)
' Backtracing-Algorithmus-Fehler behoben und verbessert (hört nicht nach erstem Logiklösungsversuch schon auf, sondern macht weiter, so lange "etwas geht" und hört erst dann auf wenn "nichts mehr geht" -> dann wird nächste Zahl versucht) - löst daher noch mehr Sudokus (ist aber leider dafür langsamer auf diese Weise)
' erster quellcodeoffener Sudoku-Muff
' v0.91a : erstmals Illegal-Prüfung für Angabenfeld eingebaut u. Hervorhebungslöschroutine f. allfällige illegale Felder, die gefunden wurden
' v0.91 : Backtracing-Algorithmus eingebaut - löst nun mehr Sudokus
' Löschung für Angaben- u. Lösungsfeld per Tastendruck
' v0.9a : ausschließlich Logik-Lösungsalgorithmus - löste relativ wenige Sudokus, dafür die "Klassiker" - alle anderen sind sowieso "menschenunwürdig" und nur etwas für Computer
' Sudoku-Muff rechnet ausschließlich mit Longs, da Shorts bzw. Integers nur früher (C-Versionen f. DOS bzw. Pascal / Delphi usw...) auf 80286ern schneller waren - auf modernen PCs ab 80386 sind Longs dagegen schneller (auch, wenn die nicht gebraucht werden)
' yyy --- yyy allgemein könnte man den Algorithmus schneller machen, indem nach der Einsetzung einer gefundenen Zahl, diese aus den Reihen, Spalten u. Arealen herausgestrichen wird und nicht immer frische Möglichkeiten gesucht werden (braucht ja seine Zeit...)
Option Explicit ' alle Variablen sollten "gedimmt" sein - Absturzvorbeugung und guter Programmierstil
Const C_areas As Long = 3
Const C_columns As Long = 2
Const C_rows As Long = 1
' anstatt true / false wegen Longverwendung die entsprechenden Werte von 1 und 0 verwenden (bei Index 0 der Zahlenspeicherfelder steht die Anzahl der einsetzbaren Zahlen - dafür reicht true/false eben nicht)
Const C_no_solution_found As Long = 0
Const C_number_impossible As Long = 0
Const C_number_possible As Long = 1
Const CS_sudoku_bar_name As String = "Sudoku-Muff-Regiezentrum" ' Name für Icon-Leiste v. Sudoku-Muff
' yyy --- yyy X-Sudoku-Vorbereitung (Koordinaten)
' Dim LA_X1_coord(9) As Long
' Dim LA_X2_coord(9) As Long
Dim L_empty_field As Long ' hier wird eine gefundene noch nicht ausgefüllte Sudoku-Koordinate geliefert
' generelle Indizes auf das jeweilige Zahlenspeicherfeld der bereits eingesetzten bzw. frisch dazuberechneten Sudoku-Ziffer anlegen (diese Variablen dienen der Adressierung der Felder)
Dim L_act_GivenCalculated_area_index As Long ' Areale
Dim L_act_GivenCalculated_column_index As Long ' Spalten
Dim L_act_GivenCalculated_row_index As Long ' Zeilen
Dim BA_filled_in(81) As Boolean ' vermerkte ausgefüllte Positionskoordinaten des Sudokus
Dim BA_illegal_sudoku_field(81) As Boolean ' hier werden illegale Sudoku-Felder vermerkt, d.h. Doppelkandidaten von Ziffern, die gegen Sudoku-Regeln verstoßen
Dim BA_non_numeric_field(81) As Boolean ' hier zwecks Prüfung festhalten, ob ein Wert keine Zahl ist -> wird dann als illegal markiert
Dim L_filled_in_counter As Long ' Zählerstand der ausgefüllten Sudoku-Felder
' die eigentlichen Zahlenspeicher ab hier anlegen (Backups folgen danach)
Dim LA_areas(9, 9) As Long ' 9 Quadrat-Areale zu je 9 Ziffern
Dim LA_columns(9, 9) As Long ' 9 Spalten zu je 9 Ziffern
' der Aufbau des Possible-Areas: Index 0 = Anzahl der möglichen einsetzbaren Ziffern an der entsprechenden Sudoku-Koordinate darin (0=keine möglich, d.h. Feld ist ausgefüllt), Indizes 1-9: 0 = Ziffer nicht möglich, 1 = Ziffer möglich
Dim LA_possibles(81, 9) As Long ' 81 Sudoku-Felder zu je 9 möglichen Ziffern darauf (1-9)
Dim LA_rows(9, 9) As Long ' 9 Zeilen zu je 9 Ziffern
' f. Backtrace-Algorithmus Sicherungsfelder anlegen, falls das Sudoku mit einem Einsetzversuch einer Zahle nicht lösbar sein sollte, damit es wiederhergestellt werden kann
' (ab hier die BACKUP-Variablen)
Dim BA_filled_in_BAK(81) As Boolean ' vermerkte ausgefüllte Positionskoordinaten des Sudokus
Dim L_filled_in_counter_BAK As Long ' Zählerstand der ausgefüllten Sudoku-Felder
Dim LA_areas_BAK(9, 9) As Long ' 9 Quadrat-Areale zu je 9 Ziffern
Dim LA_columns_BAK(9, 9) As Long ' 9 Spalten zu je 9 Ziffern
Dim LA_possibles_BAK(81, 9) As Long ' 81 Sudoku-Felder zu je 9 möglichen Ziffern darauf (1-9)
Dim LA_rows_BAK(9, 9) As Long ' 9 Zeilen zu je 9 Ziffern
Dim L_found_index_position As Long ' Fundstellenvariable für Backtracing-Algorithmus (dort wird dann eine Ziffer einzusetzen versucht)
Dim L_last_tried_number As Long ' die Ziffer, die versucht wird, dort einzusetzen
' d. Funktion überprüft, ob schon von read_given_sudoko ungültige Werte entdeckt wurden bzw. prüft selbser noch genauer nach
Function check_illegals() As Boolean
' Schleifvarialben
Dim x As Long
Dim y As Long
Dim z As Long
Dim L_sudoku_field_index As Long ' hier wird die aktuell bearbeitete Sudoku-Koordinate gespeichert
check_illegals = False ' davon ausgehen, dass Funktion korrekt ohne Duplikatenfund oder ungültige Fundwerte durchläuft - falls doch etwas gefunden wird, wird das Flag auf true gesetzt
For x = 1 To 9 ' 9 Reihen, Spalten bzw. Areale abgrasen
For y = 1 To 8 ' 9 Indices werden miteinander vergleichen (Schleife nur bis 8, da 9. Element mit dem 8. verglichen wird, d.h. +1 im Vergleich)
' Reihen
L_sudoku_field_index = get_sudoku_field_index(C_rows, x, y) ' Sudoku-Koordinate aus den akt. Ziffernspeichern ermitteln
If BA_illegal_sudoku_field(L_sudoku_field_index) = True Then ' hat read_given_sudoku bereits etwas markiert?
check_illegals = True ' ja, dann Funktionsergebnis auf true setzen -> fehlerhafte Eingabe entdeckt
GoTo next_loop ' weiter bei nächster Sudoku-Koordinate, da einmal illegal, immer illegal und untere Tests uninteressant auf dieser Position (allfällige identische Buchstabeneingabe wurde ja auch von read_given_sudoku als illegal eingestuft, d.h. Vergleich überflüssig - dient nur korrekten, aber doppelten Ziffern)
End If
For z = 0 + y To 8 ' 8 Vergleiche pro Reihe / Spalte / Areal außer bereits verglichene Positionen ab Anfang (Selbstvergleichsverhinderung), da es insg. 9 Elemente gibt und jedes mit jedem "bubblesortmäßig" verglichen wird
If LA_rows(x, y) <> 0 And LA_rows(x, y) = LA_rows(x, z + 1) Then ' steht dort was von 0 Verschiedenes drinnen und ist dieses "Etwas" gleich einem anderen "Etwas" (0-Werte dürfen ja drinnen sein, werden aber ignoriert)
BA_illegal_sudoku_field(L_sudoku_field_index) = True ' ja, dann darf dies aber gem. den Sudoku-Regeln nicht sein - oben ermitteltes akt. Bearbeitungsfeld als illegal markieren
L_sudoku_field_index = get_sudoku_field_index(C_rows, x, z + 1) ' frisch die Sudoku-Koordinate auf das verglichene Feld ermitteln
BA_illegal_sudoku_field(L_sudoku_field_index) = True ' weil dieses natürlich auch fehlerhaft ist (=handelt sich ja um ein gefundenes Duplikat)
check_illegals = True ' Duplikatenfund vermerken als Funktionsrückgabecode
End If
Next z ' weitermachen, bis alles verglichen ist
' Spalten
L_sudoku_field_index = get_sudoku_field_index(C_columns, x, y) ' Sudoku-Koordinate aus den akt. Ziffernspeichern ermitteln
For z = 0 + y To 8 ' 8 Vergleiche pro Reihe / Spalte / Areal außer bereits verglichene Positionen ab Anfang (Selbstvergleichsverhinderung), da es insg. 9 Elemente gibt und jedes mit jedem "bubblesortmäßig" verglichen wird
If LA_columns(x, y) <> 0 And LA_columns(x, y) = LA_columns(x, z + 1) Then ' steht dort was von 0 Verschiedenes drinnen und ist dieses "Etwas" gleich einem anderen "Etwas" (0-Werte dürfen ja drinnen sein, werden aber ignoriert)
BA_illegal_sudoku_field(L_sudoku_field_index) = True ' ja, dann darf dies aber gem. den Sudoku-Regeln nicht sein - oben ermitteltes akt. Bearbeitungsfeld als illegal markieren
L_sudoku_field_index = get_sudoku_field_index(C_columns, x, z + 1) ' frisch die Sudoku-Koordinate auf das verglichene Feld ermitteln
BA_illegal_sudoku_field(L_sudoku_field_index) = True ' weil dieses natürlich auch fehlerhaft ist (=handelt sich ja um ein gefundenes Duplikat)
check_illegals = True ' Duplikatenfund vermerken als Funktionsrückgabecode
End If
Next z ' weitermachen, bis alles verglichen ist
' Areale
L_sudoku_field_index = get_sudoku_field_index(C_areas, x, y) ' Sudoku-Koordinate aus den akt. Ziffernspeichern ermitteln
For z = 0 + y To 8 ' 8 Vergleiche pro Reihe / Spalte / Areal außer bereits verglichene Positionen ab Anfang (Selbstvergleichsverhinderung), da es insg. 9 Elemente gibt und jedes mit jedem "bubblesortmäßig" verglichen wird
If LA_areas(x, y) <> 0 And LA_areas(x, y) = LA_areas(x, z + 1) Then ' steht dort was von 0 Verschiedenes drinnen und ist dieses "Etwas" gleich einem anderen "Etwas" (0-Werte dürfen ja drinnen sein, werden aber ignoriert)
BA_illegal_sudoku_field(L_sudoku_field_index) = True ' ja, dann darf dies aber gem. den Sudoku-Regeln nicht sein - oben ermitteltes akt. Bearbeitungsfeld als illegal markieren
L_sudoku_field_index = get_sudoku_field_index(C_areas, x, z + 1) ' frisch die Sudoku-Koordinate auf das verglichene Feld ermitteln
BA_illegal_sudoku_field(L_sudoku_field_index) = True ' weil dieses natürlich auch fehlerhaft ist (=handelt sich ja um ein gefundenes Duplikat)
check_illegals = True ' Duplikatenfund vermerken als Funktionsrückgabecode
End If
Next z ' weitermachen, bis alles verglichen ist
next_loop:
' yyy --- yyy allenfalls die X-Reihen bei X-Sudoku-Erweiterung hier behandeln lassen (ACHTUNG - sind nur 2 Stück -> eigene 2-er-Schleife daher!)
Next y ' nächster Index
Next x ' nächste(s) Reihe / Spalte / Areal
End Function ' check_illegals
' d. Sub liest ein gegebenes Sudoku ein - dieser Programmteil muss bei Transpilation in andere Programmiersprachen / Systeme (nicht Excel) angepasst werden
' wichtig ist dabei, dass am Schluss die bereits gegebenen Sudoku-Zahlen in den Datenfeldern für Zeilen, Spalten u. Areale stehen
' die reinen Berechnungs- u. Lösungsalgorithmen dagegen brauchen nur 1:1 in die jeweilige Zielprogrammiersprache übertragen werden
' die Ausgaberoutine der gefundenen und fertig generierten Datenfelder muss jedoch wieder an lokale Gegebenheiten angepasst werden
Private Sub read_given_sudoku(L_row, L_column As Long)
' xxx --- xxx bei Änderung der Sudoku-Größe bzw. Position hier die Konstanten ändern
Const C_given_sudoku_start_column = 14
Const C_sudoku_start_row = 2
' Spalten und Zeilen anlegen
Dim L_startcolumn As Long
Dim L_startrow As Long
Dim L_sudoku_field_index As Long
Dim L_read_value As Long
' Laufvariablen für die Schleifen anlegen (nehmen je nachdem Sudoku-Feld-Koordinaten, Zeilen bzw. Spalten oder Ziffern auf)
Dim x As Long
Dim y As Long
Dim z As Long
On Error Resume Next ' falls Stringwerte in die Longs eingelesen werden sollten, diesen Fehler abfangen lassen (passieren kann nichts, da check_illegals auf die Strings aufmerksam macht, da diese ja hier schon 1. gar nicht eingelesen u. 2. in BA_non_numeric_field vermerkt(xx) werden)
' Startspalte und -zeile initialisieren (wo die Sudoku-Werte eben in der Excel-Tabelle beginnen)
' xxx --- xxx bei Erweiterung anpassen
L_startcolumn = C_given_sudoku_start_column ' Zuweisung der Konstante für die Startspalten
L_startrow = C_sudoku_start_row ' Zuweisung der Konstante für die Startzeile
' hier wird zuerst ein Feld angelegt, das vermerkt, ob an einem bestimmten Sudoku-Feld (1-81) überhaupt ein Wert ausgefüllt ist
' außerdem wird die Anzahl ausgefüllter Felder addiert, damit man weiß, wennn alle 81 ausgefüllt sind -> dann ist das Sudoku gelöst
L_filled_in_counter = 0 ' zuerst von keinem vorausgefüllten Feld ausgehen
y = 0 ' Startspalte innerhalb des Sudokus auf 0 setzen
z = 0 ' Startzeile innerhalb des Sudokus auf 0 setzen
For x = 1 To 81 ' 81 Sudoku-Felder abgrasen für Test auf ungültige Angabendaten
' xxx --- xxx bei Erweiterung umcodieren, wenn alphanumerische Sudokus gelöst werden sollen (yyy --- yyy: Empfehlung: Symbolen Zahlen zuweisen und weiterhin mit Zahlen rechnen lassen, sonst wird man deppert -> intern dann aus einem Zahlenspeicher die Zahlen des Sudokus lesen lassen)
If IsNumeric(Cells(L_startrow + z, L_startcolumn + y)) = False Then ' keine Zahl vorhanden?
BA_illegal_sudoku_field(x) = True ' ja, Feld als ungültig vermerken
BA_filled_in(x) = False ' Feld auch als nicht ausgefüllt vermerken
' yyy --- yyy später hier Umwandlung in Zahlen durchführen f. Sudoku-Erweiterung um Alpha-Zeichen
BA_non_numeric_field(x) = True ' es liegt kein numerischer Wert vor -> vermerken im Alphazeichenfeld
GoTo next_loop
Else
BA_non_numeric_field(x) = False ' numerischer Wert liegt vor -> vermerken für Highlight-Ausgabentest, damit 0 igoriert wird
End If
L_read_value = Cells(L_startrow + z, L_startcolumn + y)
If L_read_value >= 0 And L_read_value < 10 Then ' steht im betreffenden Feld ein gültiger Ziffernwert?
BA_illegal_sudoku_field(x) = False ' ja, Feld als gültig vermerken
If L_read_value <> 0 Then
BA_filled_in(x) = True ' Feld als korrekt ausgefüllt vermerken
L_filled_in_counter = L_filled_in_counter + 1 ' Anzahl der ausgefüllten Felder erhöhen (sind nämlich 81 von 81 am Schluss ausgefüllt, ist das Sudoku gelöst)
End If
Else
BA_illegal_sudoku_field(x) = True ' ansonsten Feld als ungültig vermerken
' zzz --- zzz diese Stellen dahingehend checken, ob wenn diese Initialisierung weggelassen werden alles korrekt weiterläuft (Feld = sowieso illegal, d.h. es wird abgebrochen werden mit dank check_illegals und highlight_illegals)
BA_filled_in(x) = False ' Feld auch als nicht ausgefüllt vermerken
End If
next_loop:
y = y + 1 ' Spaltenzähler erhöhen
If x Mod 9 = 0 Then ' 9 Zahlen / Reihe -> wenn ohne Rest teilbar, dann neue Zeile abrasen
y = 0 ' dazu Spaltenzähler wieder auf 0 setzen
z = z + 1 ' Zeilenzähler dagegen auf nächste Sudoku-Zeile setzen
End If
Next x ' nächstes Sudoku-Feld bearbeiten
' genereller Hinweis: in VBA werden allfällig eingelesene Alphawerte (von Zahlen verschieden) als 0 eingelesen - darum ist oben ja ohnehin schon das betreffende Feld als illegal eingestuft für check_illegals
' hier werden die horizontalen und veritikalen Sudoku-Reihen eingelesen
For x = 0 To 8 ' je 9 Zeilen / Spalten
For y = 0 To 8 ' und 9 Spalten / Zeilen
LA_rows(x + 1, y + 1) = Cells(L_startrow + x, L_startcolumn + y) ' jeweiligen Zeilenwert einlesen
LA_columns(x + 1, y + 1) = Cells(L_startrow + y, L_startcolumn + x) ' jeweiligen Spaltenwert einlesen
Next y ' nächste Spalte / Zeile
Next x ' nächste Zeile / Spalte
' xxx --- xxx alle Zahlen entsprechend anpassen bei Sudoku-Größenänderung
' hier werden die 9 Quadrat-Areale des Sudokus mit je 3 untereinanderliegenden Zahlenreihen zu je 3 Ziffern eingelesen
For z = 0 To 6 Step 3 ' eine Quadrat-Areal-Reihe hat horizontal 3 Ziffern
For x = 0 + z To 2 + z ' 3 Quadrat-Areale / Sudoku-Zeile sind betroffen
For y = 0 To 2 ' jeweils 3 Zahlen davon / Quadrat-Areal zuordnen
L_sudoku_field_index = get_sudoku_field_index(C_areas, x + 1, 1 + y) ' Sudoku-Koordinate aus den akt. Ziffernspeichern ermitteln
If BA_non_numeric_field(L_sudoku_field_index) = False Then ' prüfen, ob dort tatsächlich eine Zahl steht -> Vermeidung von Buchstaben / Zeicheneinlesung (für check_illegals, da Zeichencodes dann in den Longs vorkommen und die zufällig auch mit Ziffern übereinstimmen könnten -> illegale Stellen markiert, wo keine sind)
LA_areas(x + 1, 1 + y) = Cells(L_startrow, L_startcolumn + y) ' jeweils 1., 2. u. 3. Ziffer des 1. betroffenen Quadrat-Areals einlesen
End If
L_sudoku_field_index = get_sudoku_field_index(C_areas, x + 1, 4 + y) ' Sudoku-Koordinate aus den akt. Ziffernspeichern ermitteln
If BA_non_numeric_field(L_sudoku_field_index) = False Then ' prüfen, ob dort tatsächlich eine Zahl steht -> Vermeidung von Buchstaben / Zeicheneinlesung (für check_illegals, da Zeichencodes dann in den Longs vorkommen und die zufällig auch mit Ziffern übereinstimmen könnten -> illegale Stellen markiert, wo keine sind)
LA_areas(x + 1, 4 + y) = Cells(L_startrow + 1, L_startcolumn + y) ' jeweils 1., 2. u. 3. Ziffer des 2. betroffenen Quadrat-Areals einlesen
End If
L_sudoku_field_index = get_sudoku_field_index(C_areas, x + 1, 7 + y) ' Sudoku-Koordinate aus den akt. Ziffernspeichern ermitteln
If BA_non_numeric_field(L_sudoku_field_index) = False Then ' prüfen, ob dort tatsächlich eine Zahl steht -> Vermeidung von Buchstaben / Zeicheneinlesung (für check_illegals, da Zeichencodes dann in den Longs vorkommen und die zufällig auch mit Ziffern übereinstimmen könnten -> illegale Stellen markiert, wo keine sind)
LA_areas(x + 1, 7 + y) = Cells(L_startrow + 2, L_startcolumn + y) ' jeweils 1., 2. u. 3. Ziffer des 3. betroffenen Quadrat-Areals einlesen
End If
Next y
L_startcolumn = L_startcolumn + 3 ' Startspalte für jeweils nächste Quadrat-Areal-Ziffer befindet sich jeweils 3 Ziffern weiter rechts
Next x
L_startrow = L_startrow + 3 ' Startzeile für jeweils nächstes Quadrat-Areal befindet sich jeweils 3 Ziffern unter aktueller Quadrat-Areale-Zeile
L_startcolumn = C_given_sudoku_start_column ' Startspalte wieder auf 1. Ziffer setzen (=ganz links)
Next z
On Error GoTo 0 ' Errorhandler wieder deaktivieren (hier konnten nur Einlesefehler der Art "Unsinn" in Longs auftreten...)
End Sub ' read_given_sudoku
' d. Sub sichert den aktuellen Sudoku-Stand in den Backup-Variablen
' yyy --- yyy hier könnte man durch DMA bzw. Maschinesprache ein gewaltiges Geschwindigkeitsplus herausholen (nicht in VBA!)
Private Sub backup_sudoku()
Dim x As Long ' Kopierschleifenvarialben
Dim y As Long
For x = 0 To 9 ' vollständige (inkl. 0-Index f. allfällige Zusatz-Daten...) Sicherung d. Reihen, Spalten, Areale
For y = 0 To 9 ' vollständige (inkl. 0-Index f. allfällige Zusatz-Daten...) Sicherung d. Ziffern 1-9
LA_rows_BAK(x, y) = LA_rows(x, y) ' Reihen bearbeiten
LA_columns_BAK(x, y) = LA_columns(x, y) ' Spalten bearbeiten
LA_areas_BAK(x, y) = LA_areas(x, y) ' Areale bearbeiten
Next y
Next x
For x = 0 To 81 ' auch den akt. Ausfüllstatus der 81 Sudoku-Felder sichern
BA_filled_in_BAK(x) = BA_filled_in(x) ' Statusfeld bearbeiten
Next x
L_filled_in_counter_BAK = L_filled_in_counter ' auch akt. Füllstand sichern
For x = 0 To 81 ' auch den akt. Möglichkeitenstatus sichern
For y = 0 To 9
LA_possibles_BAK(x, y) = LA_possibles(x, y) ' sichern
Next y
Next x
End Sub ' backup_sudoku
' d. Sub stellt den aktuellen Sudoku-Stand aus den Backup-Variablen wieder her
' yyy --- yyy hier könnte man durch DMA bzw. Maschinesprache ein gewaltiges Geschwindigkeitsplus herausholen (nicht in VBA!)
Private Sub restore_sudoku()
Dim x As Long ' Kopierschleifenvarialben
Dim y As Long
For x = 0 To 9 ' vollständige (inkl. 0-Index f. allfällige Zusatz-Daten...) Wiederherstellung d. Reihen, Spalten, Areale
For y = 0 To 9 ' vollständige (inkl. 0-Index f. allfällige Zusatz-Daten...) Wiederherstellung d. Ziffern 1-9
LA_rows(x, y) = LA_rows_BAK(x, y) ' Reihen bearbeiten
LA_columns(x, y) = LA_columns_BAK(x, y) ' Spalten bearbeiten
LA_areas(x, y) = LA_areas_BAK(x, y) ' Areale bearbeiten
Next y
Next x
For x = 0 To 81 ' auch den akt. Ausfüllstatus der 81 Sudoku-Felder sichern
BA_filled_in(x) = BA_filled_in_BAK(x) ' Statusfeld bearbeiten
Next x
L_filled_in_counter = L_filled_in_counter_BAK ' auch akt. Füllstand wieder herstellen
For x = 0 To 81 ' auch den akt. Möglichkeitenstatus wiederherstellen
For y = 0 To 9
LA_possibles(x, y) = LA_possibles_BAK(x, y) ' wiederherstellen
Next y
Next x
End Sub ' restore_sudoku
' d. Funktion sucht die möglichen einsetzbare Ziffer basierend auf den bisher gegebenen und schon dazuberechneten (d.h. also, wie es weitergeht)
Function generate_possibles() As Long
Dim L_act_index As Long ' die akt. Index-Position im jeweiligen Zahlenspeicherfeld (wo entweder vermerkt wird, oder nicht)
Dim L_number As Long ' die eigentliche gefundene Ziffer
Dim L_possibles_counter As Long ' die Anzahl der möglichen einsetzbaren Ziffern
Dim L_sudoku_field_index As Long ' die akt. Sudoku-Koordinate, an der die entsprechenden Ziffern gebildet werden
' Possibles-Feld löschen, damit keine Störrreste drinnen bleiben (ist z.B. der Fall beim Wikipedia-Sudoku "rechts oben" an Koordinate 69 -> 9 wird dann illegalerweise geliefert -> Wahrscheinlichkeit hoch, dass auch andere Sudokus mit derartigem Fehler möglich sind)
' yyy --- yyy hier könnte man durch DMA bzw. Maschinesprache ein gewaltiges Geschwindigkeitsplus herausholen (nicht in VBA!)
For L_sudoku_field_index = 1 To 81 ' 81 Sudoku-Felder durchlaufen
For L_act_index = 0 To 9 ' jeweils 9 potentielle Ziffern darin
LA_possibles(L_sudoku_field_index, L_act_index) = 0 ' 0-Setzung durchführen
Next L_act_index ' nächsten Ziffernspeicher bearbeiten
Next L_sudoku_field_index ' nächste Sudoku-Koordinate bearbeiten
' jeweils 9 mögliche Reihen zu je 9 möglichen Ziffern auf 9 möglichen Koordinaten in jeweils 9 möglichen Indexfeldern speichern (=Möglichkeitsspeicher)
For L_sudoku_field_index = 1 To 81 ' 81 Sudoku-Felder durchlaufen
If BA_filled_in(L_sudoku_field_index) = True Then ' steht an der entsprechenden Sudoku-Koordinate schon eine Zahl?
GoTo next_loop ' ja, dann ist es überflüssig, weiterzumachen (und verlangsamt die Suche nach möglichen einsetzbaren Ziffern nur: es gäbe hier keine) -> aus Geschwindigkeitsgründen daher gleich zur nächsten Koordinate springen
End If
Call get_indices(L_sudoku_field_index) ' aktuelle Indizes anhand der Sudoku-Koordinate auf das jeweilige Zahlenspeicherfeld ermitteln
L_possibles_counter = 9 ' zuerst davon ausgehen, dass auf der jeweiligen Koordinate alle Ziffern von 1-9 eingesetzt werden können
For L_number = 1 To 9 ' jeweils 9 mögliche Ziffern durchlaufen
For L_act_index = 1 To 9 ' jeweils 9 Index-Einträge in den bereits gegebenen / errechneten Zeilen- und Spaltenspeicher-Feldern abgrasen (=damit vergleichen, ob aktuelle Zahl darin vorkommt)
If L_number = LA_rows(L_act_GivenCalculated_row_index, L_act_index) Then ' aktuelle Ziffer in Reihenkombination nicht einsetzbar (=weil sie schon einmal vorkommt)?
LA_possibles(L_sudoku_field_index, L_number) = C_number_impossible ' ja, dann diese Ziffer als unmöglich einstufen
L_possibles_counter = L_possibles_counter - 1 ' restliche Möglichkeiten auf restliche Anzahl an Ziffern beschränken
Exit For ' weiter mit nächster Zahl, da weitere Tests auf DIESE Zahl uninteressant (einmal unmöglich gewesen = immer unmöglich an der Stelle im Sudoku)
End If
If L_number = LA_columns(L_act_GivenCalculated_column_index, L_act_index) Then ' aktuelle Ziffer in Spaltenkombination nicht einsetzbar (=weil sie schon einmal vorkommt)?
LA_possibles(L_sudoku_field_index, L_number) = C_number_impossible ' ja, dann diese Ziffer als unmöglich einstufen
L_possibles_counter = L_possibles_counter - 1 ' restliche Möglichkeiten auf restliche Anzahl an Ziffern beschränken
Exit For ' weiter mit nächster Zahl, da weitere Tests auf DIESE Zahl uninteressant (einmal unmöglich gewesen = immer unmöglich an der Stelle im Sudoku)
End If
If L_number = LA_areas(L_act_GivenCalculated_area_index, L_act_index) Then ' aktuelle Ziffer in Arealkombination nicht einsetzbar (=weil sie schon einmal vorkommt)?
LA_possibles(L_sudoku_field_index, L_number) = C_number_impossible ' ja, dann diese Ziffer als unmöglich einstufen
L_possibles_counter = L_possibles_counter - 1 ' restliche Möglichkeiten auf restliche Anzahl an Ziffern beschränken
Exit For ' weiter mit nächster Zahl
End If
' yyy --- yyy hier allenfalls den Einbau einer X-Sudoku-Testbedingung einbauen
LA_possibles(L_sudoku_field_index, L_number) = C_number_possible ' Unmöglichkeit der akt. Ziffer in der Schleife nicht festgestellt, dann die aktuelle Ziffer im Feld als einsetzbar vermerken
Next L_act_index ' weiter mit der gleichen Zahl bei der nächsten Indexposition der Reihen-, Spalten- und Arealspeicher - ob sie dort vorkommt
LA_possibles(L_sudoku_field_index, 0) = L_possibles_counter ' aktuellen Stand der möglichen einsetzbaren Zahlen an Indexstelle 0 vermerken (0 wird in einem Sudoku nicht verwendet - der Platz dient daher als Anzahlspeicher)
If L_possibles_counter = 1 Then ' wurde beim Durchlauf der Zahlen bereits eine einzige verbleibende Möglichkeit gefunden
L_found_index_position = L_sudoku_field_index ' ja, dann die gefundene Sudoku-Koordinate in der Globalvariable liefern
For L_act_index = 1 To 9 ' die einzige verbleibende Nummer jetzt heraussuchen (im Fall des Wikipedia-Sudokus "rechts oben", wird hier aber nichts gefunden)
If (LA_possibles(L_sudoku_field_index, L_act_index)) = C_number_possible Then ' Suche nach der einzelnen gefundenen Zahl vornehmen
generate_possibles = L_act_index ' im Funktionscode die gefundene Einzelzahl vermerken: Hauptprogramm > 0 = Signal, dass eine Sofortzahl da ist
Exit Function ' Einzelziffer gefunden -> Funktionsende (nach Einsetzung im Hauptprogramm ändern sich ohnehin wieder die Möglichkeiten, d.h. die werden dann frisch generiert)
End If
Next L_act_index ' weitermachen, bis die Zahl gefunden ist
End If
Next L_number
next_loop:
Next L_sudoku_field_index
generate_possibles = C_no_solution_found ' es wurde (vorerst) keine eindeutige Zahl bei der Möglichkeitsbildung gefunden -> muss Hauptprogramm nun mit Lösungsalgorithmen machen (=einmaliger Fund einer möglichen Zahl in Reihen oder Spalten bzw. im Extremfall auf Backtracing gehen)
End Function ' generate_possibles
' d. Sub zeigt d. Copyright-Hinweis (und allenfalls weitere Informationen an)
Private Sub display_info_and_copyright()
MsgBox ("Sudoku-Muff v0.93 - REV 1, (c) 2010 by Muffa Issog, www.issog.com / keine kommerzielle, sondern nur akademische Verwendung - no commercial use, for academic purposes only")
' Anweisung hier sicherheitshalber, damit ja alle Variablenreste gelöscht werden - für wiederholte Makroaufrufe
End
End Sub
' d. Sub dient f. den Aufruf aus der Symbolleiste, damit daraus eine Abfrage gestellt werden kann, die dann allenfalls die Symbolleiste wie beim Datei-Schließen ausblendet
Private Sub autoclose_caller()
If MsgBox("Soll die Sudoku-Muff-Symbolleiste wirklich ausgeblendet werden? Falls ja, bringt Sie STRG-SHIFT-B wieder hervor...", vbOKCancel) = vbOK Then
Call auto_close
End If
End ' Anweisung hier sicherheitshalber, damit ja alle Variablenreste gelöscht werden - für wiederholte Makroaufrufe
End Sub
' d. Funktion berechnet anhand eines Index auf Reihen-, Spalten bzw. Arealspeicher die jeweilige korrespondierende Sudoku-Koordinate (=somit das Gegenteil von get_indices)
Function get_sudoku_field_index(RCA, index_x, index_y As Long) As Long
' Variablen zur Berechnung der Sudoku-Koordinate aus der Areal-Koordinate anlegen
Dim L_area_x As Long
Dim L_area_y As Long
Dim L_area_column As Long
Dim L_area_row As Long
Dim L_sudoku_coordinate As Long
' RCA (1 = Reihen, 2 = Spalten, 3 = Areale)
' index_x = Indexnummer d. jeweiligen Speicherfeldes (=Reihe-, Spalten- bzw. Arealnummer)
' index_y = Index innerhalb d. jeweiligen Speicherfeldes (der eigentliche Ziffernspeicher)
Select Case RCA ' Berechnungswunsch?
Case 1 ' -> Reihen (einfach mit Formel)
get_sudoku_field_index = index_x * 9 - (9 - index_y)
Exit Function ' fertig / Achtung: beim Transpilieren in C/Java & Co. "break" geben, damit die Case-Anweisung nicht "durchfällt" (in VBA nicht erforderlich - steht hier zur Geschwindigkeitsoptimierung) zzz --- zzz
Case 2 ' -> Spalten (einfach mit Formel)
get_sudoku_field_index = index_y * 9 - (9 - index_x)
Exit Function ' fertig / Achtung: beim Transpilieren in C/Java & Co. "break" geben, damit die Case-Anweisung nicht "durchfällt" (in VBA nicht erforderlich - steht hier zur Geschwindigkeitsoptimierung) zzz --- zzz
Case 3 ' -> Areale (aufwendig...)
' Areal-Spalte ermitteln
L_area_x = index_x Mod 3 ' zuerst anhand der Areal-Nummer die Areal-Spalte ermitteln (=ein Vielfaches der Unterspalten), d.h. ein Rest entspricht der eigentlichen Arealnummer innerhalb einer Zeile von Arealen
If L_area_x = 0 Then ' gibt es aber keinen Rest (0)?
L_area_x = 3 ' ja, dann ist es die letzte Arealnummer innerhalb einer Arealzeile gewesen -> anstatt der "0" eben diese zuweisen (hier die "3", da 3 Areale pro Sudokuzeile tangiert werden)
End If
' nun die Spalte innerhalb des Areals selbst ermitteln
L_area_column = index_y Mod 3 ' innerhalb eines Areals ist der Spaltendivisionsrest die darin enthaltene Arealspalte
If L_area_column = 0 Then ' gibt es aber keinen Rest (0)?
L_area_column = 3 ' ja, dann ist es die letzte Arealspalte innerhalb des Areals gewesen -> anstatt der "0" eben diese zuweisen (hier die "3", da jeweils 3 Spalten pro Areal eine Arealzeile bilden)
End If
' nun die Zeile innerhalb des Areals selbst ermitteln
If index_y Mod 3 > 0 Then ' gibt es einen Rest von der Zeile innerhalb des Areals?
L_area_row = Int(index_y / 3) + 1 ' ja, dann Ganzzahlquotient z.zgl. der nächsten Zeile nehmen (davaon stammt ja der Rest...)
Else
L_area_row = index_y / 3 ' kein Rest, dann die Ganzzahldivision durchführen - die liefert dann die Zeile innerhalb des Areals
End If
' und noch die eigentliche Areal-Zeile ermitteln
If index_x Mod 3 = 0 Then ' kein Rest?
L_area_y = index_x / 3 ' ja, dann erst einmal die Areal-Vollzeilen ermitteln (=ganzzahliges Vielfaches der Sudoku-Areale pro Zeile)
L_area_y = L_area_y - 1 ' da in diesem Fall aber nicht die max. Anzahl an Vollzeilen genommen werden dürfen wegen der Berechnung unten durch areal-interne Zeilen und Spalten, d. Areal-Vollzeilen um 1 vermindern - sonst würde eine Ganze dazugezählt werden, was hier 3*9 also 27 Koordinaten daneben bedeuten würde an Sudoku-Koordinaten
Else
L_area_y = Int(index_x / 3) ' bei Rest die Areal-Vollzeilen "normal" ermitteln, der "Rest" wird ja unten aus den areal-internen Zeilen und Spalten dazuberechnet (darum werden ja die areal-internen Zeilen und Spalten errechnet)
End If
' jetzt sind sowohl Areal-Koordinaten, wie interne Zeile und Spalte im Areal bekannt - nun kann daraus die Sudoku-Koordinate errechnet werden
' yyy --- yyy Formel in nur einer Zeile (wäre schneller, aber unübersichtlicher...)
L_sudoku_coordinate = L_area_y * 3 * 9 ' das 3-fache davon (Areale-Zeilen-Anzahl) und das Sudoku-Zeilenvielfache (9) ergibt die bestehenden Koordinaten-Vollzeilen (falls welche da sind, anonsten ist L_area_y 0 und es kommt 0 heraus, dann wird weiter anhand der vorhandenen restl. Werte berechnet - die Sudoku-Koordinate liegt dann aber innerhalb der ersten Areal-Zeile)
L_sudoku_coordinate = L_sudoku_coordinate + (L_area_row - 1) * 9
L_sudoku_coordinate = L_sudoku_coordinate + (L_area_x - 1) * 3 + L_area_column
get_sudoku_field_index = L_sudoku_coordinate ' errechnete Sudoku-Koordinate übergeben
Exit Function ' fertig / Achtung: beim Transpilieren in C/Java & Co. "break" geben, damit die Case-Anweisung nicht "durchfällt" (in VBA nicht erforderlich - steht hier zur Geschwindigkeitsoptimierung) zzz --- zzz
End Select
End Function ' get_sudoku_field_index
' d. Sub berechnet anhand der Sudoku-Koordinate den Index in den jeweiligen Zeilen, Spalten bzw. Areal-Speicher und hält dies in den entsprechenden Globalvariablen fest
Private Sub get_indices(L_sudoku_field_index As Long)
' Variablen zur Berechnung der akt. Sudoku-Areal-Koordinate anlegen
Dim L_area_x As Long
Dim L_area_y As Long
L_act_GivenCalculated_row_index = Int(L_sudoku_field_index / 9) ' alle 9 Koordinaten beginnt eine neue Sudkou-Zeile (=Zeilenspeicherindex)
If L_sudoku_field_index Mod 9 > 0 Then ' gibt es einen Rest?
L_act_GivenCalculated_row_index = L_act_GivenCalculated_row_index + 1 ' ja, dann ist es schon die nächste Zeile
End If
' aktuellen Index anhand der Sudoku-Koordinate auf den jeweiligen Spaltenspeicher ermitteln
If L_sudoku_field_index Mod 9 = 0 Then ' ist die Spalte ohne Rest teilbar
L_act_GivenCalculated_column_index = 9 ' ja, dann ist es automatisch die letzte Spalte (die 9.)
Else
L_act_GivenCalculated_column_index = L_sudoku_field_index Mod 9 ' nein, dann ist es der Rest, der übrig ist
End If
' aktuellen Index anhand der Sudoku-Koordinate auf den jeweiligen Arealspeicher ermitteln
L_area_x = Int(L_act_GivenCalculated_column_index / 3) ' Spaltenkoordinate (alle 3 Koordinaten beginnt eine neue Areal-Spalte)
If L_act_GivenCalculated_column_index Mod 3 > 0 Then ' gibt es einen Rest?
L_area_x = L_area_x + 1 ' ja, dann ist es schon die nächste Areal-Spalte
End If
L_area_y = Int(L_act_GivenCalculated_row_index / 3) ' Zeilenkoordinate (alle 3 Koordinaten beginnt eine neue Areal-Zeile)
If L_act_GivenCalculated_row_index Mod 3 > 0 Then ' gibt es einen Rest?
L_area_y = L_area_y + 1 ' ja, dann ist es schon die nächste Areal-Zeile
End If
' Endberechung der Areal-Koordinate
L_act_GivenCalculated_area_index = L_area_y * 3 - (3 - L_area_x) ' Areal-Zeilenvielfaches (x3) abzüglich akt. Areal-Zeilenposition = die Arealkoordinate
End Sub ' get_indices
' d. Sub setzt eine Ziffer in die Sudoku-Ziffernspeicherfelder ein und passt die entsprechenden darauf basierenden Variablen an
Private Sub fill_in_number(L_sudoku_field_index, L_number As Long)
Dim L_area_index As Long
Dim L_area_x As Long
Dim L_area_y As Long
Dim L_call_sudoku_field_index As Long ' nur f. (Visual) Basic eine Puffervariable deklarieren, um unten get_indices aufrufen zu können
Dim L_niller As Long
' yyy --- yyy hier könnte man durch DMA bzw. Maschinesprache ein gewaltiges Geschwindigkeitsplus herausholen (nicht in VBA!)
For L_niller = 0 To 9 ' alle Indizes der möglichen Zahlen für die jeweilige Sudoku-Koordinate auf 0 setzen / Index 0 ist damit automatisch gleich mit auf Möglichkeitsanzahl: 0 gesetzt
LA_possibles(L_sudoku_field_index, L_niller) = 0 ' akt. eingesetze Zahl aus dem Möglichkeitspool eliminieren an dieser Stelle - für korrekten Neu-Lauf von generate_possibles - damit dort nicht die akt. Zahl drinnen bleibt (Initialisierungs-/Neusetz-Schleife wird ja bei einer ausgefüllten Sudoku-Koordinate an dieser Stelle zwecks Ausführungsgeschwindigkeit übersprungen - somit käme die Routine zum Löschen an der Stelle dort nicht zur Ausführung)
Next L_niller
L_call_sudoku_field_index = L_sudoku_field_index ' VBA-Spezifisches: Zwecks folgendem Aufruf den übergebenen Koordinatenwert in eine Variable lesen
Call get_indices(L_call_sudoku_field_index) ' Indizes auf die Zahlenspeicher ermitteln - die ermittelte Ziffer muss jeweils in den Reihen-, Spalten- u. Arealspeicherfeldern eingesetzt werden für weitere korrekte Berechnungsläufe
LA_rows(L_act_GivenCalculated_row_index, L_act_GivenCalculated_column_index) = L_number ' gefundene Ziffer im Reihenspeicherfeld einsetzen
LA_columns(L_act_GivenCalculated_column_index, L_act_GivenCalculated_row_index) = L_number ' gefundene Ziffer im Spaltenspeicherfeld einsetzen
' Arealspeicherfeld fehlt noch -> aktuellen Index anhand der durch Spalten und Zeilen definierten Sudoku-Koordinate auf das jeweilige Arealspeicherfeld ermitteln
L_area_x = L_act_GivenCalculated_column_index Mod 3 ' die von get_indices gelieferten Ziel-Berechnungen auf das Spaltenspeicherfeld heranziehen
L_area_y = L_act_GivenCalculated_row_index Mod 3 ' die von get_indices gelieferten Ziel-Berechnungen auf das Reihenspeicherfeld heranziehen
' Areal-Zeilen- und -Spalten-Nummer-Endberechnung durchführen
If L_area_x = 0 Then ' gab es keinen Rest bei den Spalten?
L_area_x = 3 ' ja -> dann auf die letzte Spalten setzen (ist dann nämlich die Letze gewesen)
End If
If L_area_y = 0 Then ' gab es keinen Rest bei den Zeilen?
L_area_y = 3 ' ja -> dann auf die letzte Zeile setzen (ist dann nämlich die Letze gewesen)
End If
' yyy --- yyy L_area_index kann in die Klammer gehen und geschmissen werden auch beim DIM
L_area_index = L_area_y * 3 - (3 - L_area_x) ' anhand des ermittelten Areals den Index auf das Arealspeicherfeld berechnen
LA_areas(L_act_GivenCalculated_area_index, L_area_index) = L_number ' in das (noch von get_indices gelieferte) Arealspeicherfeld am errechneten Indexplatz die entsprechende Ziffer eintragen
L_filled_in_counter = L_filled_in_counter + 1 ' nun ist um eine Ziffer mehr im Sudoku ausgefüllt -> den Zähler anpassen
BA_filled_in(L_sudoku_field_index) = True ' damit diese Koordinate auch übersprungen werden kann bei der Möglichkeitsbildung und den Tests auf Einzelvorkommen von Zahlen darin in Reihen oder Spalten bzw. bei der Suche nach noch freien (noch nicht ausgefüllten) Koordinaten im Sudoku beim Backtracing, die "Ausfüllung" hier vermerken
End Sub ' fill_in_number
' d. Funktion sucht anhand der möglichen einsetzbaren Ziffern nach dem Vorkommen von genau einer solchen Möglichkeitsziffer innerhalb von Reihen, Spalten und Arealen - diese MUSS es dann auch sein
Function find_only_one_possible() As Long
Dim L_number As Long
Dim L_single_counter As Long
Dim L_sudoku_field_index As Long
Dim L_row_counter As Long
Dim L_column_counter As Long
' Suchschleifenvariablen anlegen
Dim x, y, z As Long
' yyy --- yyy VBA-spezifische Aufrufparameter anlegen (könnte in anderen Programmiersprachen anders sein)
Dim L_call_x As Long
Dim L_call_y As Long
' ---------------------------------------------------------------------------------------------------------------------------------------------
' Code für Horizontaltest (=die Reihen) auf Einzelvorkommen einer Sudoko-Ziffer, die genau einmal in den ermittelten möglichen Ziffern vorkommt
' ---------------------------------------------------------------------------------------------------------------------------------------------
' xxx --- xxx Anpassen bei Sudoku-Änderung
For y = 1 To 73 Step 9 ' 9 Zahlenspeicher für Reihen sind zu bearbeiten
' xxx --- xxx Anpassen bei Sudoku-Änderung
For z = 1 To 9 ' jeweils 9 Ziffern kommen darin pro Reihe vor
L_single_counter = 0 ' Initialisierung d. Fundzählers - der sollte auf 1 bleiben, ansonsten gibt es keine Einzelmöglichkeit an der jeweiligen Koordinate mit der jeweiligen Ziffer
' xxx --- xxx Anpassen bei Sudoku-Änderung
For x = 1 To 9 ' 9 Koordinaten sind zu bearbeiten
L_sudoku_field_index = y + x - 1 ' Sudoku-Koordinate anhand Koordinatenformel für Reihen ermitteln
If BA_filled_in(L_sudoku_field_index) = True Then ' ist dort schon eine Zahl eingesetzt?
GoTo next_loop ' ja -> weiter mit nächster Koordinate (Geschwindigkeitsgründe und Vermeidung, auf alte nicht gelöschte Möglichkeitsziffern zu treffen)
End If
If LA_possibles(L_sudoku_field_index, z) = C_number_possible Then ' ist die akt. Ziffer dort möglich?
L_single_counter = L_single_counter + 1 ' ja -> vermerken
If L_single_counter = 1 Then ' kam die Zahl genau einmal vor (=verblieb der Einzelzähler auf 1)?
L_found_index_position = L_sudoku_field_index ' ja, gefundene Sudoku-Koordinate in Globalvariable sichern (=vorerst davon ausgehen, dass dies auch weiterhin so bleibt, ansonsten wird die Koordinate sowieso neu überschrieben -> wird aber für Exit Function unten gebraucht, falls der Zähler tatsächlich auf 1 bleiben sollte - das weiß man ja vorher nicht)
End If
End If
next_loop:
Next x ' nächste Koordinate bearbeiten
If L_single_counter = 1 Then ' wurde die Einsatzmöglichkeit der Ziffer nur einmal gefunden (=blieb der Zähler die ganze Zeit auf 1)?
find_only_one_possible = z ' im Funktionscode die gefundene Zahl vermerken - Hauptprogramm: >0 = eine gefundene Lösungsziffer da u. die Zahl >0 ist sie gleich auch
Exit Function ' Funktionsende
End If
Next z ' nächste Zahl bearbeiten
Next y ' nächste Reihe bearbeiten
' --------------------------------------------------------------------------------------------------------------------------------------------
' Code für Vertikaltest (=die Spalten) auf Einzelvorkommen einer Sudoko-Ziffer, die genau einmal in den ermittelten möglichen Ziffern vorkommt
' --------------------------------------------------------------------------------------------------------------------------------------------
' xxx --- xxx Anpassen bei Sudoku-Änderung
For x = 1 To 9 ' 9 Zahlenspeicher für Spalten sind zu bearbeiten
' xxx --- xxx Anpassen bei Sudoku-Änderung
For z = 1 To 9 ' jeweils 9 Ziffern kommen darin pro Spalte vor
L_single_counter = 0 ' Initialisierung d. Fundzählers - der sollte auf 1 bleiben, ansonsten gibt es keine Einzelmöglichkeit an der jeweiligen Koordinate mit der jeweiligen Ziffer
' xxx --- xxx Anpassen bei Sudoku-Änderung
For y = x To x + 72 Step 9 ' Sudoku-Koordinate anhand Koordinatenformel für Spalten ermitteln (hier in der Schleifenschrittweite)
L_sudoku_field_index = y ' und nur jeweilige Koordinate ermitteln
If BA_filled_in(L_sudoku_field_index) = True Then ' ist dort schon eine Zahl eingesetzt?
GoTo next_loop1 ' ja -> weiter mit nächster Koordinate (Geschwindigkeitsgründe und Vermeidung, auf alte nicht gelöschte Möglichkeitsziffern zu treffen)
End If
If LA_possibles(L_sudoku_field_index, z) = C_number_possible Then ' ist die akt. Ziffer dort möglich?
L_single_counter = L_single_counter + 1 ' ja -> vermerken
If L_single_counter = 1 Then ' kam die Zahl genau einmal vor (=verblieb der Einzelzähler auf 1)?
L_found_index_position = L_sudoku_field_index ' ja, gefundene Sudoku-Koordinate in Globalvariable sichern (=vorerst davon ausgehen, dass dies auch weiterhin so bleibt, ansonsten wird die Koordinate sowieso neu überschrieben -> wird aber für Exit Function unten gebraucht, falls der Zähler tatsächlich auf 1 bleiben sollte - das weiß man ja vorher nicht)
End If
End If
next_loop1:
Next y ' nächste Koordinate bearbeiten
If L_single_counter = 1 Then ' wurde die Einsatzmöglichkeit der Ziffer nur einmal gefunden (=blieb der Zähler die ganze Zeit auf 1)?
find_only_one_possible = z ' im Funktionscode die gefundene Zahl vermerken - Hauptprogramm: >0 = eine gefundene Lösungsziffer da u. die Zahl >0 ist sie gleich auch
Exit Function ' Funktionsende
End If
Next z ' nächste Zahl bearbeiten
Next x ' nächste Spalte bearbeiten
' --------------------------------------------------------------------------------------------------------------------------
' Code für Arealtest auf Einzelvorkommen einer Sudoko-Ziffer, die genau einmal in den ermittelten möglichen Ziffern vorkommt
' --------------------------------------------------------------------------------------------------------------------------
' xxx --- xxx Anpassen bei Sudoku-Änderung
For x = 1 To 9 ' 9 Zahlenspeicher für Areale sind zu bearbeiten
' xxx --- xxx Anpassen bei Sudoku-Änderung
For y = 1 To 9 ' jeweils 9 Ziffern kommen darin pro Areal vor
L_single_counter = 0 ' Initialisierung d. Fundzählers - der sollte auf 1 bleiben, ansonsten gibt es keine Einzelmöglichkeit an der jeweiligen Koordinate mit der jeweiligen Ziffer
For z = 1 To 9 ' 9 möglichen Ziffern / Zifferkoordinate abgrasen
L_call_x = x ' Aufrufparameter für Zahlenspeicher übergeben
L_call_y = z ' Aufrufparameter für Ziffer selbst übergeben
L_sudoku_field_index = get_sudoku_field_index(C_areas, L_call_x, L_call_y) ' hier die spezielle Arealberechnungsformel für die Ermittlung auf die entsprechende Sudoku-Koordinate der akt. durchlaufenen Arealziffer im jeweiligen Areal nutzen
If BA_filled_in(L_sudoku_field_index) = True Then ' ist dort schon eine Zahl eingesetzt?
GoTo next_loop2 ' ja -> weiter mit nächster Koordinate (Geschwindigkeitsgründe und Vermeidung, auf alte nicht gelöschte Möglichkeitsziffern zu treffen)
End If
If LA_possibles(L_sudoku_field_index, y) = C_number_possible Then ' ist die akt. Ziffer dort möglich?
L_single_counter = L_single_counter + 1 ' ja -> vermerken
If L_single_counter = 1 Then ' kam die Zahl genau einmal vor (=verblieb der Einzelzähler auf 1)?
L_found_index_position = L_sudoku_field_index ' ja, gefundene Sudoku-Koordinate in Globalvariable sichern (=vorerst davon ausgehen, dass dies auch weiterhin so bleibt, ansonsten wird die Koordinate sowieso neu überschrieben -> wird aber für Exit Function unten gebraucht, falls der Zähler tatsächlich auf 1 bleiben sollte - das weiß man ja vorher nicht)
End If
End If
next_loop2:
Next z ' nächste Koordinate bearbeiten
If L_single_counter = 1 Then ' wurde die Einsatzmöglichkeit der Ziffer nur einmal gefunden (=blieb der Zähler die ganze Zeit auf 1)?
find_only_one_possible = y ' im Funktionscode die gefundene Zahl vermerken - Hauptprogramm: >0 = eine gefundene Lösungsziffer da u. die Zahl >0 ist sie gleich auch
Exit Function ' Funktionsende
End If
Next y ' nächste Zahl bearbeiten
Next x ' nächstes Areal bearbeiten
find_only_one_possible = False ' falls Funktion bis hier durchgelaufen ist, wurde nichts gefunden -> melden
End Function ' find_only_one_possible
' d. Funktion sucht aus den vorhandenen Möglichkeit für das jeweiligen Sudoku-Feld eine einsetzbare Spekulativzahl (für den Backtracing-Algorithmus, der damit dann weiter zu lösen versucht)
Function find_backtracing_possible(L_sudoku_field_index, L_possible_index As Long) As Long
Dim x As Long ' Suchschleifenindex
For x = L_possible_index To 9 ' ab vom Backtracing-Algorithmus übergebener Ziffer suchen, ob es allenfalls noch verbleibende mögliche Ziffern im aktuellen Sudoku-Feld gibt
If LA_possibles(L_sudoku_field_index, x) <> 0 Then ' gibt es eine?
find_backtracing_possible = x ' ja, dann diese übergeben
Exit Function ' Funktion beeendet
End If
Next x ' ansonsten weitermachen bis etwas gefunden wird
find_backtracing_possible = 0 ' oder die Suchschleife keine mögliche Ziffer mehr auf der jeweiligen Sudoku-Koordinate anbieten kann, dann wird 0 geliefert, damit der Backtracing-Algorithmus weiß, die nächsten freien Sudoku-Koordinate zu übermitteln (mit find_empty_sudoku_field_index kriegt er die... und Index 1 muss natürlich zwecks neuer Suche nach Spekulativzahlen an der so gefundenen Sudoku-Koordinate übermittelt werden)
End Function
' d. Funktion sucht nach einem noch nicht ausgefüllten Sudoku-Feld (für den Backtracing-Algorithmus)
Function find_empty_sudoku_field_index(L_start_index As Long) As Long
Dim x As Long ' Suchschleifenindex
For x = L_start_index To 81 ' max. 81 Sudoku-Felder sind abzugrasen
If BA_filled_in(x) = False Then ' fehlt an einer Sudoku-Koordinate noch eine Ziffer?
find_empty_sudoku_field_index = x ' ja, dann diese Koordinate übergeben
Exit Function ' Funktion beeendet
End If
Next x ' ansonsten weitermachen bis etwas gefunden wird
' yyy --- yyy guter Programmierstil - handelt sich aber um toten Code, da sonst die Funktion (=noch nicht ausgefüllte Zahl auf der Sudoku-Koordinate nicht aufgerufen werden würde - Sudoku wäre bereits gelöst!)
find_empty_sudoku_field_index = 0 ' hat die Suchschleife keine freie Stelle mehr im Sudoku gefunden, wird 0 geliefert (kommt aber nicht vor!)
End Function
' d. Sub löscht sowohl das Sudoku-Angaben- als auch das Sudoku-Lösungs-Feld
Private Sub empty_given_and_solution_field()
Call empty_solution_field
Call empty_given_sudoku_field
End Sub
' d. Sub löscht das Sudoku-Lösungsfeld
' xxx --- xxx Anpassen bei Transpilation in andere Sprachen / Systeme (Ein- / Ausgaberoutine)
' yyy --- yyy Optimierung mit Übergabekoordinaten (was wo gelöscht werden soll -> zahlt sich auch bei Anlegen / Löschen zu speichernder Sudokus aus - braucht aber Aufrufmakro für Benutzer dann))
Private Sub empty_solution_field()
ActiveSheet.Unprotect ' Arbeitsblatt entsperren für Löscharbeiten NUR IN EXCEL (xxx --- xxx)
Application.ScreenUpdating = False ' Bildschirmaktualisierung (Flackerung bei Makros) verhindern bei Auswahl / Löschung
Range(Cells(2, 2), Cells(10, 10)).Select ' Excel-spezifische Ansteuerung der entsprechenden Sudoku-Lösungszellen
Selection.ClearContents ' eigentliche Inhaltslöschung durchführen
Selection.Interior.ColorIndex = xlNone ' allfällige Hervorhebungsfarben löschen
Call restore_font_to_standard ' Standardschrift und Standardhintergrund der Zellen wieder herstellen (ohne Hervorhebungen im Hintergrund)
Range("B11:J11").Select ' Statuszeile darunter mit Lösungsstandangaben anwählen
Selection.ClearContents ' Statuszeile löschen
Range(Cells(2, 14), Cells(2, 14)).Select ' Ansteuerung des oberen Ecks im Sudoku-Eingabefeldes
Application.ScreenUpdating = True ' Bildschirmaktualisierung wieder zulassen
ActiveSheet.Protect ' Arbeitsblatt wieder sperren NUR IN EXCEL (xxx --- xxx)
End Sub
' d. Sub löscht das zu lösende Sudoku
' xxx --- xxx Anpassen bei Transpilation in andere Sprachen / Systeme (Ein- / Ausgaberoutine)
' yyy --- yyy Optimierung mit Übergabekoordinaten (was wo gelöscht werden soll -> zahlt sich auch bei Anlegen / Löschen zu speichernder Sudokus aus - braucht aber Aufrufmakro für Benutzer dann)
Private Sub empty_given_sudoku_field()
ActiveSheet.Unprotect ' Arbeitsblatt entsperren für Löscharbeiten NUR IN EXCEL (xxx --- xxx)
Application.ScreenUpdating = False ' Bildschirmaktualisierung (Flackerung bei Makros) verhindern bei Auswahl / Löschung
Call empty_highlighted_fields ' gleich alle allfälligen Hervorhebungen illegaler Felder mitlöschen lassen
ActiveSheet.Unprotect ' empty_highlighted_fields schützt Arbeitsblatt wieder (kann ja auch über Symbolleiste aufgerufen werden), darum hier wieder entsperren NUR IN EXCEL (xxx --- xxx)
Range(Cells(2, 14), Cells(10, 22)).Select ' Excel-spezifische Ansteuerung der entsprechenden Sudoku-Eingabezellen
Selection.ClearContents ' eigentliche Inhaltslöschung durchführen
Selection.Interior.ColorIndex = xlNone ' allfällige Hervorhebungsfarben löschen
Call restore_font_to_standard ' Standardschrift und Standardhintergrund der Zellen wieder herstellen (ohne Hervorhebungen im Hintergrund)
Range(Cells(2, 14), Cells(2, 14)).Select ' Ansteuerung des oberen Ecks im Sudoku-Eingabefeldes
Application.ScreenUpdating = True ' Bildschirmaktualisierung wieder zulassen
ActiveSheet.Protect ' Arbeitsblatt wieder sperren NUR IN EXCEL (xxx --- xxx)
End Sub
' d. Sub gibt ein (gelöstes) Sudoku aus
' xxx --- xxx Anpassen bei Transpilation in andere Sprachen / Systeme (Ein- / Ausgaberoutine)
Sub write_sudoku(L_start_row, L_start_column As Long)
' Ausgabeschleifvarialben
Dim x As Long
Dim y As Long
Application.ScreenUpdating = False ' Bildschirmaktualisierung (Flackerung bei Makros) verhindern bei Auswahl / Löschung
' Initialisierung der Startzeile / -spalte vornehmen für Ausgabeschleife vornehmen
L_start_row = L_start_row - 1
L_start_column = L_start_column - 1
For x = 1 To 9 ' 9 Zeilen / Spalten
For y = 1 To 9 ' zu je 9 Elementen darin (=die Sudoku-Ziffern)
If LA_rows(x, y) <> 0 Then ' 0-Ausgbe vermeiden, falls Sudoku nicht ganz gelöst werden konnte
Cells(L_start_row + x, L_start_column + y) = LA_rows(x, y) ' es reicht, die Zeilen auszugeben - Spalten und Areale beinhalten im fertig gelösten Sudoku logischerweise die gleichen Ziffern, aber die haben ja bloß der Sudoko-Berechnung gedienten und sind für Doppel- bzw. Dreifachausgabe überflüssig
End If
Next y
Next x
Application.ScreenUpdating = True ' Bildschirmaktualisierung wieder zulassen
End Sub
' d. Funktion versucht das Sudoku ausschließlich anhand der Logik zu lösen (=Einzelvorkommensuche aus den möglichen Ziffern bzw. Einzelvorkommen aus den Möglichkeiten in Reihen, Spalten oder Arealen)
Function try_logic_solve() As Boolean
Dim L_try_counter As Long
Dim L_found_number As Long
For L_try_counter = L_filled_in_counter To 81 ' Lösungssuchschleife initialisieren (Differenz aus den 81 Sudoku-Feldern abzüglich der bereits vorausgefüllten davon)
L_found_number = generate_possibles ' die einsetzbare Ziffern beschaffen lassen (falls sofort eine eindeutige Möglichkeit gefunden wird, steht die "Sofortziffer" im Funktionsergebnis)
If L_found_number > 0 Then ' wurde tatsächlich schon eine Einzelmöglichkeit gefunden?
Call fill_in_number(L_found_index_position, L_found_number) ' ja -> dann spricht nichts dagegen, die gefundene Ziffer einzusetzen (in der Globalvariable L_found_index_position steht nach Beschaffung der möglichen Ziffern die Indexposition für die gefundene Ziffer)
' ddd --- ddd Debug-Code
' Call empty_solution_field ' Lösungsfeld löschen
' Call write_sudoku(2, 2) ' momentanen Sudoku-Lösungsstand testweise ausgeben
GoTo next_loop ' gleich nächsten Schleifendurchlauf starten, um sich frische Möglichkeiten bzw. eine Sofortziffer geben zu lassen (falls abermals möglich)
End If
L_found_number = find_only_one_possible ' noch keine Sofortziffer bei der Möglichkeitssuche gefunden heißt nächste Funktion bemühen: Reihen u. Spalten der möglichen einsetzbaren Ziffern nach Einzelvorkommen von genau einer einzigen (alleinstehenden) Ziffer abgrasen
If L_found_number > 0 Then ' spätestens jetzt sollte etwas gefunden sein - wurde es gefunden?
Call fill_in_number(L_found_index_position, L_found_number) ' gefunden -> einsetzen
' ddd --- ddd Debug-Code
' Call empty_solution_field ' Lösungsfeld löschen
' Call write_sudoku(2, 2) ' momentanen Sudoku-Lösungsstand testweise ausgeben
Else
Exit For ' nicht gefunden -> Ende der Suche - Sudoku im gegebenen Zustand nicht ausschließlich anhand der Logik lösbar, Lösungsschleifenversuchsende
End If
next_loop:
Next L_try_counter
If L_filled_in_counter = 81 Then ' sind alle 81 Sudoku-Felder ausgefüllt, d.h. war die Lösungsschleife erfolgreich?
try_logic_solve = True ' ja, positive Lösung melden
Else
try_logic_solve = False ' nein, dann wurde die Lösungsschleife vorzeitig beendet -> Negativ melden, damit Hauptprogramm "härtere Geschütze" auffährt, d.h auf Backtracingmodus geht
End If
End Function ' try_logic_solve
' d. Funktion setzt eine Ziffer spekulativ ins Sudoku ein - das kommt beim Backtracing zur Anwendung, wenn Logik allein nicht zum Ziel führt und mehrere Möglichkeiten existieren, wie es weitergehen könnte
Function try_fill_in(L_try_start_field, L_try_number As Long) As Boolean
' yyy --- yyy in anderen Programmiersprachen wäre es möglich, hier direkt die der Routine selbst übergebene Variable zu verwenden
Dim L_call_start_index As Long ' Aufruf der Suchroutine vorbereiten (reine Übergabevariable)
L_call_start_index = L_try_start_field ' Start-Sudoku-Koordinate übergeben für Aufruf der Suchroutine, wo es noch weitere freie Sudoku-Felder gibt
L_empty_field = find_empty_sudoku_field_index(L_call_start_index) ' Suche nach dem erstbesten noch nicht ausgefüllten Feld ab dem übergebenen durchführen
L_last_tried_number = find_backtracing_possible(L_empty_field, L_try_number) ' Suche nach erstbester (niedrigster) passender Ziffer auf dem so gefundenen Feld
If L_last_tried_number > 0 Then ' wurde tatsächlich eine noch nicht versuchte Ziffer dort gefunden
Call fill_in_number(L_empty_field, L_last_tried_number) ' ja, dann testweises Probeeinfügen dieser gefundenen Ziffer durchführen
try_fill_in = True ' Positiv melden, damit Hauptprogramm mit dieser Spekulativziffer weiter anhand der Logik zu lösen versucht
Else
try_fill_in = False ' wenn nichts gefunden wurde auch das dem Hauptprogramm melden, damit allenfalls die Unlösbarkeitsmeldung ausgegeben wird oder eine neue Startkoordinate übermittelt wird, wo neu nach Spekulativziffern gesucht werden soll (normalerweise um eins höher)
End If
End Function ' try_fill_in
' d. Sub stellt d. Standardschrift und d. Standardhintergrund der Zellen wieder her (ohne Hervorhebungen im Hintergrund)
Private Sub restore_font_to_standard()
With Selection.Font
.Name = "Arial"
.Size = 20
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Bold = True
End With
End Sub
' d. Sub setzt die Hervorhebungsfarbe für illegale Sudoku-Felder
Private Sub set_illegal_color()
ActiveSheet.Unprotect ' Arbeitsblatt entsperren für Operationen NUR IN EXCEL (xxx --- xxx)
With Selection.Interior ' Zelle einfärben
.ColorIndex = 45 ' mit gewünschtem eingestellten Farbcode
.Pattern = xlSolid ' flächige Vollfarbe verwenden
End With
Call restore_font_to_standard ' Standardschrift ebenfalls wieder herstellen
ActiveSheet.Protect ' Arbeitsblatt wieder sperren NUR IN EXCEL (xxx --- xxx)
End Sub
' d. Sub hebt gefundene sudoku-regelwidrige Duplikate hervor, damit diese vor dem Lösungsversuch vom Benutzer bereinigt werden können (und müssen!)
Private Sub highlight_illegals(L_row, L_column As Long)
Const C_rows = 1
Dim L_start_column As Long
Dim L_start_row As Long
Dim L_sudoku_coordinate As Long
' Ausgabeschleifvarialben
Dim x As Long
Dim y As Long
' Initialisierung der Startzeile / -spalte für Ausgabeschleife vornehmen
L_start_row = L_row
L_start_column = L_column
For x = 1 To 9 ' 9 Zeilen (Spalten u. Areala können unterbleiben, da alles auch in den Zeilen vorkommt = eine Ausgaberoutine u. keine Berechnungsroutine)
For y = 1 To 9 ' zu je 9 Elementen darin (=die Sudoku-Ziffern)
L_sudoku_coordinate = get_sudoku_field_index(C_rows, x, y) ' korrespondierende Sudoku-Koordinate holen
If LA_rows(x, y) = 0 And BA_non_numeric_field(L_sudoku_coordinate) = True Then ' Wert 0 (VBA Buchstaben in Long eingelesen = 0 -> soll ignoriert werden, da sonst alle unausgefüllten Felder illegal wären) und liegen dort tatsächlich auch ein oder mehrere Buchstaben vor?
Range(Cells(L_start_row + x, L_start_column + y), Cells(L_start_row + x, L_start_column + y)).Select ' ja, Zelle für Illegal-Hervorhebung anwählen
set_illegal_color ' Zelle als illegal markieren
GoTo next_loop ' weitermachen mit nächster Sudoku-Koordinate
End If
If BA_illegal_sudoku_field(L_sudoku_coordinate) = True Then ' handelt es sich um ein sonstiges illegales (regelwidriges) Sudoku-Feld (Duplikat oder zu hoher / niedriger Ziffern-Wert)?
Range(Cells(L_start_row + x, L_start_column + y), Cells(L_start_row + x, L_start_column + y)).Select ' ja, Zelle für Illegal-Hervorhebung anwählen
set_illegal_color ' Zelle als illegal markieren
End If
next_loop:
Next y ' nächstes Element (Index)
Next x ' nächste Zeile
End Sub ' highlight_illegals
' d. Sub löscht hervorgehobene Felder im Angaben- u. Lösungsfeld des Sudokus
Private Sub empty_highlighted_fields()
ActiveSheet.Unprotect ' Arbeitsblatt entsperren für Löscharbeiten NUR IN EXCEL (xxx --- xxx)
Application.ScreenUpdating = False ' Bildschirmaktualisierung (Flackerung bei Makros) verhindern bei Auswahl / Löschung
' yyy --- yyy Variablen verwenden
Range(Cells(2, 14), Cells(10, 22)).Select ' Excel-spezifische Ansteuerung der entsprechenden Sudoku-Eingabezellen
Selection.Interior.ColorIndex = xlNone ' allfällige Hervorhebungsfarben löschen
Call restore_font_to_standard ' Standardschrift und Standardhintergrund der Zellen wieder herstellen (ohne Hervorhebungen im Hintergrund)
Range(Cells(2, 2), Cells(10, 10)).Select ' Excel-spezifische Ansteuerung der entsprechenden Sudoku-Eingabezellen
Selection.Interior.ColorIndex = xlNone ' allfällige Hervorhebungsfarben löschen
Call restore_font_to_standard ' Standardschrift und Standardhintergrund der Zellen wieder herstellen (ohne Hervorhebungen im Hintergrund)
Range(Cells(2, 14), Cells(2, 14)).Select ' Ansteuerung des oberen Ecks im Sudoku-Eingabefeldes
Application.ScreenUpdating = True ' Bildschirmaktualisierung wieder zulassen
ActiveSheet.Protect ' Arbeitsblatt wieder sperren NUR IN EXCEL (xxx --- xxx)
End Sub
' d. Sub macht nichts - dient zur Abstandsbildung in der Icon-Leiste v. Sudoku-Muff als Sub zum Aufrufen, denn dort draufgedrückt wird
Private Sub dummy_sub()
Dim dummy As Long
dummy = 0
End Sub
' d. Sub erstellt die Symbolleiste f. die Schnittstellen-Makros zu Sudoku-Muff
Public Sub create_sudoku_muff_bar()
Dim CB As CommandBar ' benutzerdef. Symbolleiste reservieren
Dim CBC As CommandBarButton ' Icon (Symbol) dafür reservieren
Dim controlsymbol_name As String ' Name dafür reservieren
controlsymbol_name = CS_sudoku_bar_name ' Name anlegen
On Error Resume Next ' falls Symbolleiste schon angelegt ist, Fehlermeldung überspringen
Application.CommandBars(controlsymbol_name).Delete ' Symbolleiste löschen (damit die nicht x-fach angelegt wird bei Aufruf)
On Error GoTo 0 ' Errorhandler wieder löschen
Set CB = Application.CommandBars.Add(Name:=controlsymbol_name, temporary:=True, Position:=msoBarTop) ' nur bis Excel-Ende Symbolleiste "drin" lassen
CB.Visible = True ' Symbolleiste natürlich anzeigen
' Angabenfeld löschen-Icon anlegen
Set CBC = CB.Controls.Add(Type:=msoControlButton) ' neuen Knopf (Symbol) anlegen
With CBC
.FaceId = 485 ' Code 485 = Rasterpunkte
.Caption = "Angabenfeld löschen" ' Infotext f. was "er macht"
.OnAction = "empty_given_sudoku_field" ' Makro dem Knopf zuweisen
End With
' Lösungsfeld löschen-Icon anlegen
Set CBC = CB.Controls.Add(Type:=msoControlButton) ' neuen Knopf (Symbol) anlegen
With CBC
.FaceId = 638 ' Code 638 = Tabellengitter f. Lösungsfeld löschen
.Caption = "Lösungsfeld löschen" ' Infotext f. was "er macht"
.OnAction = "empty_solution_field" ' Makro dem Knopf zuweisen
End With
' Angaben u. Lösungsfeld löschen-Icon anlegen
Set CBC = CB.Controls.Add(Type:=msoControlButton) ' neuen Knopf (Symbol) anlegen
With CBC
.FaceId = 453 ' Code 453 = 3er-Radiergummi f. Mehrfachlöschung (eben Angaben u. Lösungsfeld)
.Caption = "Angaben- und Lösungsfeld löschen" ' Infotext f. was "er macht"
.OnAction = "empty_given_and_solution_field" ' Makro dem Knopf zuweisen
End With
' Hervorhebungen löschen-Icon anlegen
Set CBC = CB.Controls.Add(Type:=msoControlButton) ' neuen Knopf (Symbol) anlegen
With CBC
.FaceId = 352 ' Code 352 = rote Birne f. hervorgehobene Felder löschen
.Caption = "hervorgehobene Felder löschen" ' Infotext f. was "er macht"
.OnAction = "empty_highlighted_fields" ' Makro dem Knopf zuweisen
End With
' Abstand-Icon anlegen
Set CBC = CB.Controls.Add(Type:=msoControlButton) ' neuen Knopf (Symbol) anlegen
With CBC
.FaceId = 332 ' Code 332 = Platzhalterleerfläche
.Caption = "" ' Infotext f. was "er macht"
.OnAction = "dummy_sub" ' Makro dem Knopf zuweisen
End With
' Sudoku lösen-Icon anlegen
Set CBC = CB.Controls.Add(Type:=msoControlButton) ' neuen Knopf (Symbol) anlegen
With CBC
.FaceId = 625 ' Code 625 = Zauberstab f. Sudoku lösen
.Caption = "gegebenes Sudoku lösen" ' Infotext f. was "er macht"
.OnAction = "solve_sudoku" ' Makro dem Knopf zuweisen
End With
' Abstand-Icon anlegen
Set CBC = CB.Controls.Add(Type:=msoControlButton) ' neuen Knopf (Symbol) anlegen
With CBC
.FaceId = 332 ' Code 332 = Platzhalterleerfläche
.Caption = "" ' Infotext f. was "er macht"
.OnAction = "dummy_sub" ' Makro dem Knopf zuweisen
End With
' Tastaturkommandos-Reset-Icon anlegen
Set CBC = CB.Controls.Add(Type:=msoControlButton) ' neuen Knopf (Symbol) anlegen
With CBC
.FaceId = 64 ' Code 64 = Tastatur f. Tastaturkommandos frisch zuweisen
.Caption = "Reset der Tastaturkommandos" ' Infotext f. was "er macht"
.OnAction = "set_key_commands" ' Makro dem Knopf zuweisen
End With
' Symbolleiste ausblenden-Icon anlegen
Set CBC = CB.Controls.Add(Type:=msoControlButton) ' neuen Knopf (Symbol) anlegen
With CBC
.FaceId = 657 ' Code 657 = Symboleisten f. Symbolleiste ausblenden
.Caption = "Symbolleiste entfernen" ' Infotext f. was "er macht"
.OnAction = "autoclose_caller" ' Makro dem Knopf zuweisen
End With
' Hilfe- u. Info-Icon anlegen
Set CBC = CB.Controls.Add(Type:=msoControlButton) ' neuen Knopf (Symbol) anlegen
With CBC
.FaceId = 345 ' Code 345 = Birne mit Fragezeichen f. Copyright bzw. Hilfe
.Caption = "über Sudoku-Muff" ' Infotext f. was "er macht"
.OnAction = "display_info_and_copyright" ' Makro dem Knopf zuweisen
End With
End Sub
' d. Sub weist d. essentiellen Schnittstellen-Makros zu Sudoku-Muff Tastenkombinationen zu
Public Sub set_key_commands()
Application.OnKey "^A", "empty_given_and_solution_field"
Application.OnKey "^B", "create_sudoku_muff_bar"
Application.OnKey "^C", "auto_close"
Application.OnKey "^G", "empty_given_sudoku_field"
Application.OnKey "^H", "empty_highlighted_fields"
Application.OnKey "^L", "empty_solution_field"
Application.OnKey "^S", "solve_sudoku"
End Sub
' d. Sub setzt die Tastenkombinationen und erstellt d. Symbolleiste f. die Rechnung
Private Sub auto_open()
Call set_key_commands
Call create_sudoku_muff_bar
End Sub
' d. Sub setzt die Tastenkombinationen und erstellt d. Symbolleiste f. die Rechnung
Private Sub auto_close()
Dim CB As CommandBar ' benutzerdef. Symbolleiste reservieren
Dim CBC As CommandBarButton ' Icon (Symbol) dafür reservieren
Dim controlsymbol_name As String ' Name dafür reservieren
controlsymbol_name = CS_sudoku_bar_name ' Name anlegen
On Error Resume Next ' falls Symbolleiste schon angelegt ist, Fehlermeldung überspringen
Application.CommandBars(controlsymbol_name).Delete ' Symbolleiste löschen (damit die nicht x-fach angelegt wird bei Aufruf)
On Error GoTo 0 ' Errorhandler wieder löschen
End ' Anweisung hier sicherheitshalber, damit ja alle Variablenreste gelöscht werden - für wiederholte Makroaufrufe
End Sub
' -------------
' Hauptprogramm
' -------------
' xxx --- xxx dies muss void bzw. int main() bei C-Transpilation werden
' d. Sub holt sich ein gegebenes Sudoku, versucht es zu lösen bzw. gibt allenfalls Unlösbarkeits- oder Falschangabenwarnungen aus, sollten doppelte Zahlen in unzulässiger Weise vorkommen - wenn aber eine Lösung gefunden wurde, so wird das gelöste Sudoku ausgegeben
Private Sub solve_sudoku()
' xxx --- xxx Meldungen
Const CS_illegal_sudoku_fields As String = "Dieses Sudoku ist nicht lösbar, da regelwidrige Angabenfelder entdeckt wurden (hervorgehoben)"
Const CS_logic_solve_message As String = "Sudoku erfolgreich durch reine Logik gelöst - dieses Sudoku ist daher menschenwürdig, da es durch reines Ausschlussverfahren der möglichen einsetzbaren Ziffern lösbar ist (d.h., die Schritte 1-3, die neben stehen)!"
Const CS_no_sudoku17_present As String = "Es ist kein sog. ""Sudoku 17"" vorhanden - nur Sudokus mit mind. 17 ausgefüllten und ausgewogen verteilten Felder sind eindeutig lösbar! Sie haben bisher: "
Const CS_no_sudoku_present As String = "Bitte geben Sie im Angabenfeld ein zu lösendes Sudoku ein!"
Const CS_solve_message_with_backtracing As String = "Sudoku erfolgreich durch zwangsweises Einsetzen von Ziffern gelöst (ein Mensch würde hier schon lange zu knacken haben...)"
Const CS_surrender_message As String = "Sudoku-Muff kann dieses Sudoku nicht lösen... Bitte senden sie es an die untenstehende E-Mail-Adresse (=samt der ganzen Excel-Datei, wegen der Versionsangabe von Sudoku-Muff) - Vielen Dank!"
Const CL_min_given_fields As Long = 17 ' min Anzahl an vorhandenen ausgefüllten Feldern (Sudoku-17 sollten eindeutig lösbar sein, wenn ausgewogen verteilte angaben vorhanden sind)
Dim B_last_try_status As Boolean ' wenn eine einsetzbare Ziffer an der jeweiligen Sudoku-Koordinate gefunden wird, ist es positiv, ansonsten negativ
Dim B_secflag As Boolean ' Backup-Flag f. Backtracing (damit der momentane Stand nicht wiederhergestellt wird, falls noch Ziffern ermittelt werden können, bis zu einem Widerspruch)
Dim L_filled_in_counter_checker As Long ' Prüfzählerstand der ausgefüllten Sudoku-Felder f. Backtracing -> wird was ausgefüllt, dann weiter backtracen und Sudoku NICHT wieder herstellen, bis es eben nicht mehr weiter geht
Dim L_last_tried_number_BAK As Long ' Sicherung für akt. durchprobierte Backtracing-Nummer
' yyy --- yyy wer auf aut. Abbruchsicherung verzichten will (muss dann auch auf Ausgabe des Lösungsstandszählers verzichten), kann folgende beiden Variablen streichen
Dim L_max_backtrace_counter As Long ' max Anzahl an Backtracing-Versuchen (dient für korrekten Abbruch der Lösungsschleife - sonst bestünde Endlosschleifengefahr)
Dim L_runcounter As Long ' akt. Standzähler der Backtracing-Versuche
Dim L_try_sudoku_field As Long ' hier wird die jeweilige Sudoku-Koordinate, die es zu überprüfen gilt, gespeichert
Dim L_try_sudoku_field_BAK As Long ' Sicherung d. akt. durchprobierten Sudoku-Koordinate
' yyy --- yyy X-Sudoku-Vorbereitung (Koordinaten)
' LA_X1_coord(1) = 1
' LA_X1_coord(2) = 11
' LA_X1_coord(3) = 21
' LA_X1_coord(4) = 31
' LA_X1_coord(4) = 41
' LA_X1_coord(6) = 51
' LA_X1_coord(7) = 61
' LA_X1_coord(8) = 71
' LA_X1_coord(9) = 81
' LA_X2_coord(1) = 9
' LA_X2_coord(2) = 17
' LA_X2_coord(3) = 25
' LA_X2_coord(4) = 33
' LA_X2_coord(5) = 41
' LA_X2_coord(6) = 49
' LA_X2_coord(7) = 57
' LA_X2_coord(8) = 65
' LA_X2_coord(9) = 73
' -----------
' Eingabeteil
' -----------
' yyy --- yyy Variablen für Einleseposition
Call read_given_sudoku(2, 14) ' gegebenes Sudoku am Beginn erst einmal einlesen
Call empty_solution_field ' Platz schaffen für neue Lösung im Lösungsfeld, falls dort noch was stehen sollte (und gleichzeitig Statuszeile löschen, falls Logiklösung allein zum Ziel führt -> dann braucht es keine Backtracing-Versuche)
ActiveSheet.Unprotect ' Arbeitsblatt entsperren für Operationen NUR IN EXCEL (xxx --- xxx)
' Test auf gültige Angaben
If check_illegals = True Then ' auf illegale Werte prüfen (Duplikate u. unzulässige Eingaben, d.h. zu hohe / niedrige Werte bzw. Buchstaben -> bis auf die Duplikate wurden bereits von read_given_sudoku markiert die illegalen Felder markiert, d.h. die müssen nur noch ausgewertet werden)
Call highlight_illegals(1, 13) ' wurden welche gefunden bzw. waren bereits welche markiert?
MsgBox (CS_illegal_sudoku_fields) ' ja, dann Warnmeldung ausgeben
ActiveSheet.Protect ' Arbeitsblatt wieder sperren NUR IN EXCEL (xxx --- xxx)
End ' Programmende (zzz --- zzz: End Sub würde bei 2. Aufruf fehlerhafte Ausführung bedeuten -> Grund: unklar, aber vermutlich werden nicht alle Variablen ordnungsgem. gelöscht, so dass Störreste drinnen bleiben, obwohl überall korr. Initialisierung erfolgt - zumindest konnte kein diesbezüglicher Fehler gefunden werden / oder übersehen?)
End If
' Test auf ausgefülltes Sudoku
If L_filled_in_counter = 0 Then ' liegt überhaupt eine Eingabe im Angabenfeld vor?
MsgBox (CS_no_sudoku_present) ' nein, dann darum bitten
ActiveSheet.Protect ' Arbeitsblatt wieder sperren NUR IN EXCEL (xxx --- xxx)
End ' Programmende
End If
' Test auf mind. 17 Stück eingegebener Ziffern (Sudoku-17 sollten eindeutig lösbar sein, wenn ausgewogen verteilte angaben vorhanden sind)
If L_filled_in_counter < CL_min_given_fields Then ' liegt eine "halbwegs lösbares" Sudoku überhaupt vor (17er-Sudoku)?
MsgBox (CS_no_sudoku17_present + Str(L_filled_in_counter) + " Felder ausgefüllt") ' nein, dann darum bitten
ActiveSheet.Protect ' Arbeitsblatt wieder sperren NUR IN EXCEL (xxx --- xxx)
End ' Programmende
End If
' -----------------------------------------
' Verarbeitungs- u. allfälliger Ausgabeteil
' -----------------------------------------
If try_logic_solve = True Then ' Sudoku bereits allein durch reine Logik lösbar gewesen (was wo hinein passt)
Call write_sudoku(2, 2) ' ja, Sudoku ausgeben
MsgBox (CS_logic_solve_message) ' ja, Lösungsmeldung ausgeben
ActiveSheet.Protect ' Arbeitsblatt wieder sperren NUR IN EXCEL (xxx --- xxx)
End ' Programmende (zzz --- zzz: End Sub würde bei 2. Aufruf fehlerhafte Ausführung bedeuten -> Grund: unklar, aber vermutlich werden nicht alle Variablen ordnungsgem. gelöscht, so dass Störreste drinnen bleiben, obwohl überall korr. Initialisierung erfolgt - zumindest konnte kein diesbezüglicher Fehler gefunden werden / oder übersehen?)
End If
' ddd --- ddd Debug-Code
' Call empty_solution_field ' Lösungsfeld löschen
' Call write_sudoku(2, 2) ' momentanen Lösungsstand in Angabefeld schreiben (als Ausgangsbasis für neuen Lösungsversuch)
Call backup_sudoku ' war Sudoku nicht lösbar, dann den alten Lösungsstand sichern (den aus dem Logik-Lösungsversuch) und härtere Geschütze auffahren: den Backtracing-Modus
L_last_tried_number = 1 ' Initialisierung des hier verwendeten Backtracing-Algorithums (max. niedrigste mögliche Ziffer = 1 für den Start eines Einsetzungsversuches)
' yyy --- yyy Optimierungsinitialisierung? Gleich erstes freies Feld suchen (INLINE bei C-Transpilation als Geschwindigkeitssteigerung)
L_try_sudoku_field = 1 ' erster Start für Freifeldsuche für Zifferneinsetzung bei erster Sudoku-Koordinate
' ddd --- ddd Debug-Code
' Call empty_solution_field ' Lösungsfeld löschen
' Call write_sudoku(2, 2) ' momentanen Lösungsstand in Angabefeld schreiben (als Ausgangsbasis für neuen Lösungsversuch)
B_secflag = False ' Initialisierung d. Sicherungsflags (zuerst sichern -> wenn es auf true ist, wird die Sicherung beibehalten)
' yyy --- yyy wer auf die Sicherheit d. aut. Abbruchs nach max. Lösungsversuchsanzahl verzichten kann, kann folgende Programmteile streichen (bringt etwas Geschwindigkeit beim Lösen, man muss dann aber im Unlösbarkeitsfall selbst STRG-Untbr. drücken)
L_runcounter = 0
' xxx --- xxx Anpassen bei Sudoku-Größenänderung
L_max_backtrace_counter = (81 - L_filled_in_counter - 1) * (81 - L_filled_in_counter - 1) ' max. Backtracing über d. Anzahl d. Leerkoordinaten abz. einer akt. eingesetzer Versuchsziffer und weil im Extremfall die Lösung bei der letzten freien Koordinate gefunden werden könnte das Quadrat davon
' yyy --- yyy wer nur auf die Ausgabe d. Lösungsversuchsstandes verzichten will, kann lediglich den folgenden Programmteil streichen (der kostet später nämlich d. meiste Geschwindigkeit beim Lösen)
' xxx --- xxx Ausgabekoordinaten anpassen
Cells(11, 9) = L_max_backtrace_counter ' max. Anzahl ausgeben - damit Benutzer weiß, ob er nicht vorher selbst "STRG-Untbr." drückt
Cells(11, 2) = "Versuch:"
Cells(11, 7) = "von max.:"
Do ' weitermachen mit Backtracing
B_last_try_status = try_fill_in(L_try_sudoku_field, L_last_tried_number) ' Backtracing: immer eine Zifer irgendwo einsetzen probieren, bis eine Lösung gefunden werden kann - eine Ziffer muss ja letzlich irgendwo richtig stehen
L_filled_in_counter_checker = L_filled_in_counter ' akt. Zählerstand d. ausgefüllten Sudoku-Felder sichern
If B_last_try_status = False Then ' wurde keine einsetzbare Ziffer mehr an der entsprechenden Sudoku-Koordinate gefunden?
L_try_sudoku_field = L_empty_field + 1 ' ja, dann weitermachen bei nächster Sudoku-Koordinate
' yyy --- yyy hier gleich testen, ob die noch frei ist, dann muss es die Routine nicht
L_last_tried_number = 1 ' Reinitialisierung für neue diese neue Sudoku-Koordinate (es wurde ja "Ziffer" 0 geliefert, also nichts Brauchbares)
' ddd --- ddd Debug-Code
' Call empty_solution_field ' Lösungsfeld löschen
' Call write_sudoku(2, 2) ' momentanen Sudoku-Lösungsstand testweise ausgeben
If L_try_sudoku_field > 81 Then ' wurden aber schon alle Sudoku-Koordinaten abgegrast (=ging es sich linear aus beim Backtracen, d.h. d. Reihe nach)?
Exit Do ' ja, dann ist keine Lösung mittels dem hier verwendeten Backtracing möglich - Backtracing-Lösungsschleife verlassen
End If
GoTo continue_do ' weitermachen bei der nächsten Sudoku-Koordinate
End If
' ddd --- ddd Debug-Code
' Call empty_solution_field ' Lösungsfeld löschen
' Call write_sudoku(2, 2) ' momentanen Sudoku-Lösungsstand testweise ausgeben
If try_logic_solve = True Then ' hat jetzt eine Logiklösung mit der eingesetzten Spekulativziffer funktioniert?
' yyy --- yyy wer auf die Ausgabe d. Lösungsversuchsstandes verzichtet, sollte auch das folgenden If-Konstrukt streichen
If L_runcounter = 0 Then ' wurde gleich beim 1. Versuch gelöst, d.h. ist d. Lösungsstandszähler noch initialisiert mit 0, da noch kein alter Lösungsstand wiederhergestellt wurde für die nächste Koordinate?
' xxx --- xxx Ausgabekoordinaten anpassen
Cells(11, 4) = 1 ' Ausgabe d. akt. Lösungsversuchsstandes (hier absolute 1)
End If
Call write_sudoku(2, 2) ' ja, dann die gefundene Lösung in das Lösungsfeld schreiben
MsgBox (CS_solve_message_with_backtracing) ' entsprechende Lösungsmeldung ausgeben
ActiveSheet.Protect ' Arbeitsblatt wieder sperren NUR IN EXCEL (xxx --- xxx)
End ' Programmende (zzz --- zzz: End Sub würde bei 2. Aufruf fehlerhafte Ausführung bedeuten -> Grund: unklar, aber vermutlich werden nicht alle Variablen ordnungsgem. gelöscht, so dass Störreste drinnen bleiben, obwohl überall korr. Initialisierung erfolgt - zumindest konnte kein diesbezüglicher Fehler gefunden werden / oder übersehen?)
End If
' ddd --- ddd Debug-Code
' Call empty_solution_field ' Lösungsfeld löschen
' Call write_sudoku(2, 2) ' momentanen Sudoku-Lösungsstand testweise ausgeben
L_last_tried_number = L_last_tried_number + 1 ' funktioniert die Logiklösung immer noch nicht, dann mit nächster Sekulativ-Ziffer weitermachen lassen (es wird dann ab dieser gesucht, ob schon diese oder allenfalls andere einsetzbare Ziffern existieren)
continue_do:
If B_secflag = False Then ' muss zuerst gesichert werden?
L_last_tried_number_BAK = L_last_tried_number ' ja, akt. durchprobierte Ziffer sichern
L_try_sudoku_field_BAK = L_try_sudoku_field ' ja, akt. durchprobierte Sudoku-Koordinate sichern
B_secflag = True ' ab jetzt Sicherung beibehalten, bis das Sudoku entweder gelöst ist, oder keine weiteren Ziffern mehr ermittelbar sind (d.h., ein Sudoku-Widerspruch entdeckt wurde)
End If
If L_filled_in_counter = L_filled_in_counter_checker Then ' nichts mehr weitergegangen beim "Backtracen" (d.h, es wurden tatsächlich keine gültigen einsetzbaren Ziffern mehr ermittelt -> Widerspruch: Sudoku hängt!!!)
' yyy --- yyy wer auf die Sicherheit d. aut. Abbruchs nach max. Lösungsversuchsanzahl verzichten kann, kann den folgenden Programmteil streichen (bringt etwas Geschwindigkeit beim Lösen, man muss dann aber im Unlösbarkeitsfall selbst STRG-Untbr. drücken)
L_runcounter = L_runcounter + 1 ' Lösungsversuchszähler erhöhen
If L_runcounter > L_max_backtrace_counter Then ' überschreitet der die max. Leerkoordinatenanzahl?
Exit Do ' ja, dann Lösungsschleife verlassen, Sudoku-Muff kann hier nicht weiterhelfen
End If
' yyy --- yyy wer auf die Ausgabe d. Lösungsversuchsstandes verzichten kann, kann den folgenden Programmteil streichen (der kostet nämlich d. meiste Geschwindigkeit beim Lösen)
' xxx --- xxx Ausgabekoordinaten anpassen
Cells(11, 4) = L_runcounter ' Ausgabe d. akt. Lösungsversuchsstandes
Call restore_sudoku ' den alten (ersten) Logiklösungsstand wiederherstellen (der stimmt sicher bis dahin), da akt. Backtracing-Lösungsversuch gescheitert ist
L_last_tried_number = L_last_tried_number_BAK ' gesicherte, akt. durchprobierte Ziffer ab diesem Zeitpunkt wieder herstellen
L_try_sudoku_field = L_try_sudoku_field_BAK ' gesicherte, akt. durchprobierte Sudoku-Koordinate ab diesem Zeitpunkt wieder herstellen
B_secflag = False ' für weiteres "Backtracen" an anderen Koordinaten (bis man eine Lösung findet) wieder eine Sicherung ab dort zulassen
End If
Loop ' weitermachen: nächste möglicher Ziffer einsetzen probieren
' --------------------------------------------------------------------------------------------------------------------------------------------------------
' Ausgabeteil, der hoffentlich nicht HIER zum Tragen kommt (für Kapitulationsmeldung, ansonsten wäre ja schon an anderer Stelle im Programm gelöst worden)
' --------------------------------------------------------------------------------------------------------------------------------------------------------
' yyy --- yyy Variablen für Ausgabeposition
Call write_sudoku(2, 2) ' momentanen Lösungsstand in Lösungsfeld schreiben (Sudoku konnte leider nicht gelöst werden, wenn Programm bis hierher lief)
MsgBox (CS_surrender_message) ' Kapitulationsmeldung ausgeben (sollte normalerweise in 95% aller "lösbaren sog. 17er-Sudokus", möglicherweise 99% nicht auftreten)
ActiveSheet.Protect ' Arbeitsblatt wieder sperren NUR IN EXCEL (xxx --- xxx)
End ' Anweisung hier sicherheitshalber, damit ja alle Variablenreste gelöscht werden - für wiederholte Makroaufrufe
End Sub ' solve_sudoku
zurück