Zurück zur Homepage

Sudoku

Sudoku ist ein netter Zeitvertreib, besonders wenn man recht viel davon hat. Neben dem Anwenden von etwas Logik besteht das Lösen aber hauptsächlich darin, viele, viele, und noch mehr Kombinationen durchzuprobieren, Irrwege zu bestreiten und trotzdem wieder auf den rechten Pfad zurückzufinden. Ist das Lösen eines solchen “Rätsels“ noch recht einfach, kann einem das Erzeugen von fertig ausgefüllten Sudokufeldern per Hand zur Verzweiflung bringen.

Das Spielfeld besteht bekanntermaßen aus einer Matrix von 9 mal 9 Zellen, die wiederum in 9 Felder von je 3 mal 3 Zellen aufgeteilt wird. Jede Ziffer zwischen 1 und 9 darf in jeder Zeile, jeder Spalte und jedem 3 mal 3 Zellen großen Feld nur ein einziges Mal vorkommen. Außerdem darf es nur eine einzige Lösung geben. So einfach sind die Regeln.

Was sich so einfach anhört, ist aber auf Grund der enormen Vielzahl von Kombinationsmöglichkeiten nicht einfach zu bewerkstelligen. In solch einem Fall kommt der Rechner ins Spiel, denn als nimmermüder, schneller Rechensklave lassen sich in kürzester Zeit sehr viele Kombinationen durchprobieren.

In diesem Beispiel lassen sich komplett ausgefüllte Sudokufelder erstellen und anschließend auch wieder lösen. Das Lösen ist auch für das Erzeugen wichtig, denn je nachdem, welche und wie viel Zahlen fehlen, sind unter Umständen viele tausend gültige Lösungen möglich, man möchte aber schließlich nur eine eindeutige Lösung haben. Deshalb muss man jedes Mal, wenn eine Zahl entfernt wird, Prüfen, ob immer noch nur eine Lösung möglich ist.

Vor mehr als zwei Jahren habe ich mal ein kleines Programm geschrieben, welches das gleiche gemacht hatte. Der Lösungsansatz war aber ein anderer und das Lösen hat ungleich mehr Zeit erfordert, meistens so zwischen 5 und 10 Sekunden. Das hat daran gelegen, dass ich erst alle möglichen Kombinationen von 9 Ziffern erzeugt habe und anschließend mit dem Like-Operator viele Zeichenfolgenvergleiche gemacht hatte.

Mit dem vorliegenden Code hat man je nach der Geschwindigkeit des eingesetzten Systems eine Lösung bereits nach ein paar hundert Millisekunden gefunden. Das lässt sich sicherlich noch etwas auf Geschwindigkeit trimmen, aber meiner Ansicht nach geht das dann auf Kosten der Übersichtlichkeit. Der Aufwand lohnt sich aus meiner Sicht also nicht.

Auch bei diesem Beispiel gilt, dass man den Code frei benutzen kann. Eine Veröffentlichung des Codes oder Teilen davon, womöglich noch unter anderem Namen, sollte aber unterbleiben.

Excel-Dateien zum Download ca. 100 KB: Sudoku.xlsm oder Sudoku.xls

Das Klassenmodul des Tabellenblattes Create Sudoku

Create Sudoku

Private Sub cmdCreate_Click()
   CreateMySudoku
End Sub

Private Sub cmdErase_Click()
   Dim i                   As Long
   Dim k                   As Long
   Dim p                   As Long
   Dim lngRow              As Long
   Dim lngCol              As Long
   Dim alngSource(81)      As Long
   
   Me.Range("L1:T9").Value = Me.Range("A1:I9").Value
   For i = 1 To 81
      alngSource(i) = i
   Next
   Randomize Now
   p = 81 - Me.Range("Q14").Value
   For i = 1 To p
      k = i + Int(Rnd * (81 - i) + 1)
      lngRow = (alngSource(k) - 1) \ 9 + 1
      lngCol = alngSource(k) - (lngRow - 1) * 9
      alngSource(k) = alngSource(i)
      If (k > 81) Or (k <= i) Then Stop
      Me.Cells(lngRow, lngCol + 11).ClearContents
   Next
End Sub
   
Private Sub cmdCopy_Click()
   Worksheets("Sudoku").Range("A1:I9").Value = Me.Range("L1:T9").Value
End Sub

Im Blatt “Create Sudoku“ befinden sich drei Schaltflächen. Ein Klick auf die mit der Beschriftung “Erzeugen“ füllt die Matrix A1:I9 mit einer Lösung aus. Dazu wird die Prozedur CreateMySudoku im Codemodul mdl_Create_Sudoku aufgerufen. Ein Klick auf “Ins Lösungsblatt kopieren“ kopiert die Matrix ins Blatt Sudoku ab Zelle A1. Ein Klick auf die Schaltfläche “Überzählige löschen“ löst die Ereignisprozedur cmdErase_Click aus.

Die Funktion cmdErase_Click

Zuerst wird eine Lösung aus A1:I9 in den Bereich L1:T9 kopiert. Anschließend wird ein Array mit 81 Ziffern angelegt. Aus diesem werden zufällig Elemente ausgewählt und an der in diesem Element steckenden Position wird im Zielbereich das entsprechende Feld gelöscht. Die gezogene Zahl wird aus dem Spiel genommen, indem sie mit der an der Position der Zählvariablen stehenden getauscht wird. Das geht so lange, bis noch so viel ausgefüllte Ziffern verbleiben, wie in Zelle Q14 angegeben ist.

Das Codemodul mdl_Create_Sudoku

Beginnen wir mit dem Erzeugen eines komplett ausgefüllten Sudokublattes.

Private Declare Function GetTickCount _
   Lib "kernel32" () As Long

Public Sub CreateMySudoku()
   Dim varSolution   As Variant
   Dim varSolutions  As Variant
   Dim lngBegin      As Long
   Dim i             As Long
   Dim k             As Long
   Dim m             As Long
   
   On Error Resume Next
      
   ' Zieltabelle
   With Worksheets("Create Sudoku")
   
      .Range("A1:I9").ClearContents
      
      ' Zeitpunkt Beginn speichern
      lngBegin = GetTickCount
      
      varSolutions = CreateSudoku
      
      ' Zeitdauer ausgeben
      .Range("C14").Value = Format((GetTickCount - lngBegin) / 1000, "0.000 Sekunden")

      Application.ScreenUpdating = False

      ' Alle Lösungen durchlaufen, momentan
      ' nur eine pro Durchlauf möglich
      For Each varSolution In varSolutions
         
         For i = 1 To 9
            m = m + 1
            For k = 1 To 9
               ' Wert in Tabelle schreiben
               .Cells(m, k) = varSolution(i, k)
            Next k
         Next i
         
      Next varSolution
               
   End With
   
   Application.ScreenUpdating = True
   
End Sub

Private Function CreateSudoku( _
   Optional ByVal varOrigin As Variant, _
   Optional Level As Long = 1 _
   ) As Variant
   Dim varSource                    As Variant
   Dim varOrder                     As Variant
   Dim varTmp                       As Variant
   Dim varRows                      As Variant
   Dim astrRow(1 To 9)              As String
   Dim astrCol(1 To 9)              As String
   Dim astrSqu(1 To 9)              As String
   Dim astrTmp()                    As String
   Dim i                            As Long
   Dim k                            As Long
   Dim m                            As Long
   Dim x                            As Long
   Dim p                            As Long
   Dim strAll                       As String
   ' Variablenwerte bleiben zwischen den Aufrufen bestehen
   Static blnEscape                 As Boolean
   Static varResult                 As Variant
   
   If Level = 1 Then
   
      blnEscape = False
      varResult = 0
      
      ' Zufallsgenerator initialisieren
      Randomize Now()
      ReDim varOrigin(1 To 9, 1 To 9)
      ' Reihenfolge der Anfangsziffern
      varOrder = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
      ' Elemente 1-9 mischen
      For i = 1 To 9
         k = Int(Rnd * 9 + 1)
         varOrder(0) = varOrder(i)
         varOrder(i) = varOrder(k)
         varOrder(k) = varOrder(0)
      Next
      For k = 1 To 9
         varOrigin(k, k) = varOrder(k)
      Next k
   End If
   
   ' Inhalt der Reihen, Spalten und 3x3 Rechtecke holen
   For i = 1 To 9
      For k = 1 To 9
         If Len(varOrigin(i, k)) > 0 Then
         ' Aktuelles Feld enthält eine Zahl
            ' Den Index für das aktuelle Quadrat ermitteln
            p = ((i - 1) \ 3) * 3 + ((k - 1) \ 3 + 1)
            ' Zahl zum Inhalt der aktuellen Reihe hinzu
            astrRow(i) = astrRow(i) & varOrigin(i, k)
            ' Zahl zum Inhalt der aktuellen Spalte hinzu
            astrCol(k) = astrCol(k) & varOrigin(i, k)
            ' Zahl zum Inhalt des aktuellen 3x3 Rechtecks hinzu
            astrSqu(p) = astrSqu(p) & varOrigin(i, k)
         End If
      Next k
   Next i
   
   i = Level
   For k = 1 To 9
   ' Alle Spalten der aktuellen Reihe durchlaufen
      If Len(varOrigin(i, k)) = 0 Then
         ' Den Index für das aktuelle Quadrat ermitteln
         p = ((i - 1) \ 3) * 3 + ((k - 1) \ 3 + 1)
         strAll = astrRow(i) & astrCol(k) & astrSqu(p)
         x = x + 1
         ReDim Preserve astrTmp(1 To x)
         For m = 1 To 9
         ' Ziffern 1-9 probieren
            ' Mögliche Ziffern an der freien Stelle ermitteln.
            ' Nachschauen, ob die Ziffer nicht in der aktuellen
            ' Reihe, in der aktuellen Spalte und dem aktuellen 3x3
            ' Rechteck vorkommt
            If InStr(1, strAll, CStr(m)) = 0 Then
               ' Mögliche Ziffern an freier Stelle
               astrTmp(x) = astrTmp(x) & CStr(m)
            End If
         Next m
         If Len(astrTmp(x)) = 0 Then Exit Function
      End If
   Next k
   
   ' Alle möglichen Kombinationen der aktuellen Reihe holen
   varRows = Combinations(astrTmp)
   
   ' Kombinationen Mischen
   For i = 1 To varRows(0)
      k = Int(Rnd * varRows(0) + 1)
      varTmp = varRows(i)
      varRows(i) = varRows(k)
      varRows(k) = varTmp
   Next
   
   ' Alle Kombinationen durchlaufen
   For i = 1 To varRows(0)
      varSource = varOrigin
      m = 0
      For k = 1 To 9
         ' Ziffern der Kombination an die Leerstellen setzen
         If Len(varSource(Level, k)) = 0 Then
            m = m + 1
            varSource(Level, k) = Mid(varRows(i), m, 1)
         End If
      Next k
      Select Case Level
         Case 9
            ' Lösung gefunden
            If Not IsArray(varResult) Then
               ' 1. Lösung, Array anlegen
               ReDim varResult(1 To 1)
            Else
               ' Größe des Arrays anpassen
               ReDim Preserve varResult(1 To UBound(varResult) + 1)
            End If
            ' Lösung im Array speichern
            varResult(UBound(varResult)) = varSource
            ' Variable zum Abbrechen auf WAHR setzen
            blnEscape = True
         Case Else
            ' Diese Funktion rekursiv aufrufen
            CreateSudoku varSource, Level + 1
      End Select
      ' Schleife verlassen, wenn Varianle WAHR
      If blnEscape Then Exit For
   Next i
   ' Ergebnis zurückgeben
   If Level = 1 Then CreateSudoku = varResult
End Function

Private Function Combinations( _
   astrTmp() As String, _
   Optional varResult As Variant, _
   Optional strTmp As String, _
   Optional Level As Long = 1 _
   ) As Variant
   Dim i             As Long
   Dim k             As Long
   Dim lngLen        As Long
   Dim strChar       As String
   Const lngMax      As Long = 40320
   
   ' Variablenwert bleibt zwischen den Aufrufen bestehen
   Static blnEscape  As Boolean
   
   lngLen = UBound(astrTmp)
   
   If Level = 1 Then
      blnEscape = False
      ' Ergebnisarray dimensionieren
      ReDim varResult(lngMax)
      ' Zähler (Element 0) auf Null setzen
      varResult(0) = 0
   End If
   
   For k = 1 To Len(astrTmp(Level))
      strTmp = Left(strTmp, Level - 1)
      ' Aktuelles Zeichen extrahieren
      strChar = Mid(astrTmp(Level), k, 1)
      
      If InStr(1, strTmp, strChar) = 0 Then
      ' Ziffer noch nicht in der aktuellen Reihe
         ' Zum bisherigen String die Ziffer hinzufügen
         strTmp = strTmp & strChar
         
         If Level = lngLen Then
            ' Im höchsten Level hat man eine komplette
            ' Kombination.
Zähler um 1 erhöhen
            varResult(0) = varResult(0) + 1
            ' Gefundene Kombination im Array speichern
            varResult(varResult(0)) = strTmp
            ' Verlassen, wenn die maximal gewünschte Anzahl erreicht ist
            If varResult(0) = lngMax Then blnEscape = True
         Else
            ' Diese Funktion rekursiv aufrufen
            Combinations astrTmp, varResult, strTmp, Level + 1
         End If
         
         ' Verlassen, wenn Variable WAHR
         If blnEscape Then Exit For
         
      End If
      
   Next k
   
   If Level = 1 Then
      ' Ergebnisarray kürzen
      ReDim Preserve varResult(varResult(0))
      ' und zurückgeben
      Combinations = varResult
   End If
   
End Function

Die Prozedur CreateMySudoku

Die Prozedur, welche das Erzeugen anstößt und die Lösung auf dem Tabellenblatt ausgibt, nennt sich CreateMySudoku. Zu Beginn wird darin der Ausgabebereich gelöscht und der aktuelle Zeitpunkt in Form von Millisekunden nach dem Systemstart in einer Variablen gespeichert. Dazu wird die API-Funktion GetTickCount benutzt, die diesen Wert liefert.

Die anschließend aufgerufene Funktion CreateSudoku liefert ein Variantarray mit den Lösungen zurück, in diesem Beispiel wird aber nur eine Lösung generiert. Die Zeitdauer zum Erzeugen und die zugehörige Lösung werden danach auf dem Tabellenblatt ausgegeben. Um die Ausgabegeschwindigkeit zu erhöhen, wird vor der Ausgabe die Bildschirmaktualisierung aus- und danach wieder eingeschaltet.

Die Funktion CreateSudoku

Mit Hilfe der Randomize-Anweisung wird nun der Zufallsgenerator initialisiert. Ich benutze als Startwert die Systemzeit, obwohl das eigentlich unnötig wäre. Danach erzeuge ich ein Array mit den Ziffern 0-9, das erste Element mit der Ziffer Null dient als Puffer beim anschließenden Mischen der Ziffern 1-9.

Das 9x9 Felder große, zweidimensionale Array mit dem Namen varOrigin nimmt in jeder Zeile und in jeder Spalte jeweils eine einzige Ziffer auf. Nun erzeugt man drei Arrays, eines nimmt die Ziffernfolge jeder Zeile, das zweite die Ziffernfolge jeder Spalte und das dritte die Ziffernfolge jedes der neun 3x3 Felder umfassenden Bereiche auf.

Der an die Funktion CreateSudoku zu übergebene, optionale Parameter Level hat beim ersten Aufruf den Wert 1. Dieser Wert wird benutzt, um die Zeile zu bestimmen, deren Elemente nacheinander durchlaufen werden. Enthält das aktuelle Element noch keine Ziffer, überprüft man nacheinander jede Ziffer von 1-9 daraufhin, ob diese bereits in der aktuellen Zeile, der aktuellen Spalte und dem aktuellen 9 Felder großen Bereich vorkommen. Ist das nicht der Fall, wird diese Ziffer als möglicher Kandidat für diese Position im Array astrTmp gespeichert. Mit Hilfe der Funktion Combinations wird ein Variantarray erzeugt, welches alle möglichen Kombinationen des übergebenen Arrays astrTmp enthält. Diese Kombinationen werden noch gemischt und in einer Schleife werden nacheinander alle Kombinationen für die aktuelle Zeile durchlaufen und die jeweiligen Ziffern eingesetzt.

Die nächste Reihe wird nach dem Einsetzen der Ziffern einer Kombination in der rekursiv aufgerufenen Funktion CreateSudoku erzeugt, wobei auch auf dieser Stufe alle Kombinationen nacheinander eingesetzt werden können. Bei der Parameterübergabe wird neben dem bereits mit vorhandenen Ziffern ausgefüllten zweidimensionalen Array auch der um 1 erhöhte Parameter Level übergeben.

So geht es weiter, bis man auf Level 9, also der letzten Reihe angekommen ist. Das Ergebnis wird dann in dem Array varResult gespeichert und anschließend wird die Variable blnEscape auf WAHR gesetzt. Das Bewirkt, dass nacheinander alle rekursiv aufgerufenen Funktionen verlassen werden. Auf Level 1 angekommen, wird das Array als Funktionsergebnis zurückgegeben.

Die Funktion Combinations

In dieser Funktion wird ein Array angelegt, welches alle möglichen Kombinationen der als Array übergebenen Ziffer enthält.

Dazu durchläuft man jedes Element des übergebenen Arrays, welches die möglichen Ziffern jeder einzelnen Leerstelle enthält. Im Level 1 werden nacheinander alle Ziffern des ersten Elementes eingesetzt. Nach dem Einsetzen ruft man die gleiche Funktion mit dem um 1 erhöhten Level noch einmal auf setzt nun nacheinander alle Ziffern des zweiten Elementes ein.

Das geht so lange, bis der letzte mögliche Level erreicht ist. Irgendwann sind in diesem Level alle Ziffern eingesetzt worden, nun springt man einen Level zurück, setzt die nächste Ziffer der vorletzten Position ein und springt wieder eine Stufe höher. Dort werden wieder nacheinander alle Ziffern der letzten Position eingesetzt.

Es ist aber glücklicherweise nicht so, dass man nun alle denkbaren Kombinationen durchlaufen muss, ist eine einzusetzende Ziffer bereits in der vorherigen Ziffernfolge vorhanden, wird mit der nächsten fortgefahren. Eine Ziffer wird also erst eingesetzt, wenn diese in der aktuellen Ziffernfolge einmalig ist. Hat man nun alle möglichen Kombinationen im Ergebnisarray varResult gespeichert und befindet man sich im Level 1, wird dieses als Funktionsergebnis zurückgegeben.

Das Codemodul mdl_Solve_Sudoku

Solve Sudoku

Im Lösungsblatt “Sudoku“ befindet sich eine einzige Schaltfläche. Ein Klick darauf startet einen Dialog, der abfragt, ob nur eine, oder mehrere Lösungen gesucht werden sollen. Möchte man nur eine, wird die Programmausführung bei der ersten Lösung gestoppt, im anderen Fall bei 50 Lösungen. Im ersten Fall ist die Programmausführung schneller, im letzteren werden alle Möglichkeiten bis zum gesetzten Limit ausprobiert. Ausgegeben werden die Lösungen ab Zeile 17. Zum Lösen wird intern die Prozedur SolveMySudoku im Codemodul mdl_Solve_Sudoku aufgerufen.

Fahren wird wir mit dem Lösen eines Sudokublattes fort.

Option Explicit
Private Declare Function GetTickCount _
   Lib "kernel32" () As Long

Public Sub SolveMySudoku()
   Dim varOrigin                    As Variant
   Dim varResult                    As Variant
   Dim varSolution                  As Variant
   Dim lngBegin                     As Long
   Dim i                            As Long
   Dim k                            As Long
   Dim m                            As Long
   Dim p                            As Long
   Dim blnExit                      As Boolean
   On Error Resume Next
   
   If MsgBox("Soll nur eine Lösung ausgegeben werden (schneller)?", vbYesNo) _
      = vbYes Then blnExit = True
      
   ' Zeitpunkt Beginn speichern
   lngBegin = GetTickCount
   
   ' Bereich in ein Variantarray beamen
   varOrigin = Worksheets("Sudoku").Range("A1:I9")
   
   ' Lösungen holen
   varResult = Solve(varOrigin, blnExit)
   
   ' Zieltabelle
   With Worksheets("Sudoku")
   
      .Range("F12").Value = 0
      
      ' Zeitdauer ausgeben
      .Range("J12").Value = Format((GetTickCount - lngBegin) / 1000, "0.000 Sekunden")
      
      ' Anzahl Lösungen ausgeben
      If blnExit Then
         .Range("F12").Value = " Min. " & UBound(varResult)
      Else
         If UBound(varResult) = 50 Then
            .Range("F12").Value = " Min. " & UBound(varResult)
         Else
            .Range("F12").Value = UBound(varResult)
         End If
      End If
      
      .Range("A17:I25").ClearContents
      .Range("A28:I1000").ClearContents
      
      Application.ScreenUpdating = False
      
      
      ' 1. Zeile (-1) der Lösungsausgabe
      m = 16
      
      ' Alle Lösungen durchlaufen
      For Each varSolution In varResult
         
         For i = 1 To 9
            m = m + 1
            For k = 1 To 9
               ' Wert in Tabelle schreiben
               .Cells(m, k) = varSolution(i, k)
            Next k
         Next i
         
         Application.StatusBar = "Schreibe Lösung Nr.: " & p
         
         ' Zwischen den Lösungen 2 Zeilen freilassen
         m = m + 2

      Next varSolution
         
   End With
   
   Application.StatusBar = False
   Application.ScreenUpdating = True
   
End Sub

Private Function Solve( _
   ByVal varOrigin As Variant, _
   Optional blnExit As Boolean, _
   Optional Level As Long = 1 _
   ) As Variant
   Dim varSource                    As Variant
   Dim astrRow(1 To 9)              As String
   Dim astrCol(1 To 9)              As String
   Dim astrSqu(1 To 9)              As String
   Dim astrTmp()                    As String
   Dim varRows                      As Variant
   Dim lngCount                     As Long
   Dim lngActRow                    As Long
   Dim strAll                       As String
   Dim strTmp                       As String
   Dim blnFound                     As Boolean
   ' Zählvariablen
   Dim i                            As Long
   Dim k                            As Long
   Dim m                            As Long
   Dim x                            As Long
   Dim p                            As L
ong
   ' Maximale Anzahl Lösungen
   Const lngMax                     As Long = 50
   ' Variablenwerte bleiben zwischen den Aufrufen bestehen
   Static blnEscape                 As Boolean
   Static varResult                 As Variant
   
   On Error Goto Fehlerbehandlung

   If Level = 1 Then
      blnEscape = False
      varResult = 0
   End If
      
   ' Inhalt der Reihen, Spalten und 3x3 Rechtecke holen
   For i = 1 To 9
      For k = 1 To 9
         If Len(varOrigin(i, k)) > 0 Then
         ' Aktuelles Feld enthält eine Ziffer
            ' Den Index für das aktuelle Quadrat ermitteln
            p = ((i - 1) \ 3) * 3 + ((k - 1) \ 3 + 1)
            ' Zahl zum Inhalt der aktuellen Reihe hinzu
            astrRow(i) = astrRow(i) & varOrigin(i, k)
            ' Zahl zum Inhalt der aktuellen Spalte hinzu
            astrCol(k) = astrCol(k) & varOrigin(i, k)
            ' Zahl zum Inhalt des aktuellen 3x3 Rechtecks hinzu
            astrSqu(p) = astrSqu(p) & varOrigin(i, k)
            If Level = 1 Then varOrigin(i, k) = CStr(varOrigin(i, k))
         Else
            ' Leeren Variant in Leerzeichen umwandeln
            If Level = 1 Then varOrigin(i, k) = ""
         End If
      Next k
   Next i
   
   Do
      blnFound = False
      ' Eindeutige Werte einsetzen
      For i = 1 To 9
         For k = 1 To 9
            If Len(varOrigin(i, k)) = 0 Then
               x = 0: strTmp = ""
               ' Aktuellen Block ermitteln
               p = ((i - 1) \ 3) * 3 + ((k - 1) \ 3 + 1)
               strAll = astrRow(i) & astrCol(k) & astrSqu(p)
               For m = 1 To 9
                  If InStr(1, strAll, CStr(m)) = 0 Then
                     strTmp = CStr(m): x = x + 1
                     ' Mögliche Ziffern an dieser Position zählen
                  End If
               Next m
               If x = 1 Then
                  ' Wenn nur eine Ziffer möglich ist, diese
                  ' einsetzen und die Arrays der aktuellen
                  ' Reihe, der aktuellen Spalte und des aktuellen
                  ' Blocks ergänzen.
                  astrRow(i) = astrRow(i) & strTmp
                  astrCol(k) = astrCol(k) & strTmp
                  astrSqu(p) = astrSqu(p) & strTmp
                  varOrigin(i, k) = strTmp
                  blnFound = True
               End If
            End If
         Next k
      Next i
      ' So lange durchlaufen, wie Werte eingesetzt
      ' werden können
   Loop While blnFound
   
   lngCount = -1
   For i = 1 To 9
      ' Die Zeile mit den meisten Ziffern suchen,
      ' die aber keine 9 Einträge hat. Wenn nur
      ' noch Leerzeilen vorhanden sind, eine davon
      ' nehmen.
Wenn alles ausgefüllt ist, bleibt
      ' die Variable lngActRow bei Null
      m = Len(astrRow(i))
      If m < 9 Then
         If (m > lngCount) Then
            lngCount = Len(astrRow(i))
            lngActRow = i
         End If
      End If
   Next
   
   If lngActRow = 0 Then
      ' Eine Lösung ist gefunden worden
      If Not IsArray(varResult) Then
         ' 1.
Lösung, Array anlegen
         ReDim varResult(1 To 1)
      Else
         ' Größe des Arrays anpassen
         ReDim Preserve varResult(1 To UBound(varResult) + 1)
      End If
      ' Anzahl Lösungen speichern
      lngCount = UBound(varResult)
      ' Lösung im Array speichern
      varResult(lngCount) = varOrigin
      ' Verlassen, wenn gewünscht
      If blnExit Then blnEscape = True
      ' Max Anzahl erreicht. beenden
      If lngCount = lngMax Then blnEscape = True
      
   Else
      i = lngActRow: x = 0
      ReDim astrTmp(1 To 9)
      For k = 1 To 9
      ' Alle Spalten der aktuellen Reihe durchlaufen
         x = x + 1
         If Len(varOrigin(i, k)) = 0 Then
            ' An der Position befindet sich noch keine Ziffer
            ' Den Index für das aktuelle Quadrat ermitteln
            p = ((i - 1) \ 3) * 3 + ((k - 1) \ 3 + 1)
            strAll = astrRow(i) & astrCol(k) & astrSqu(p)
            For m = 1 To 9
            ' Ziffern 1-9 probieren
               ' Mögliche Ziffern an der freien Stelle ermitteln.
               ' Nachschauen, ob die Ziffer nicht in der aktuellen
               ' Reihe, in der aktuellen Spalte und dem aktuellen
               ' 3x3 Rechteck vorkommt
               If InStr(1, strAll, CStr(m)) = 0 Then
                  ' Mögliche Ziffern an freier Stelle im Array
                  ' speichern
                  astrTmp(x) = astrTmp(x) & CStr(m)
               End If
            Next m
            If Len(astrTmp(x)) = 0 Then Exit Function
         Else
            ' An der Position befindet sich eine Ziffer
            astrTmp(x) = varOrigin(i, k)
         End If
      Next k
      
      
      ' Alle möglichen Kombinationen der aktuellen Reihe holen
      varRows = Combinations(astrTmp)
      
      ' Alle Kombinationen durchlaufen
      For i = 1 To varRows(0)
         ' Kopie der Quelldaten auf dieser Ebene erzeugen
         varSource = varOrigin
         For k = 1 To 9
            ' Ziffern der Kombination an die Leerstellen setzen
            varSource(lngActRow, k) = Mid(varRows(i), k, 1)
         Next k
         
         Select Case Level
            Case 9
               ' Lösung gefunden
               If Not IsArray(varResult) Then
                  ' 1.
Lösung, Array anlegen
                  ReDim varResult(1 To 1)
               Else
                  ' Größe des Arrays anpassen
                  ReDim Preserve varResult(1 To UBound(varResult) + 1)
               End If
               ' Anzahl Lösungen speichern
               lngCount = UBound(varResult)
               ' Lösung im Array speichern
               varResult(lngCount) = varSource
               ' Verlassen, wenn gewünscht
               If blnExit Then blnEscape = True
               ' Max Anzahl erreicht. beenden
               If lngCount = lngMax Then blnEscape = True
            Case Else
               ' Diese Funktion rekursiv aufrufen
               Solve varSource, blnExit, Level + 1
         End Select
         ' Schleife verlassen, wenn Varianle WAHR
         If blnEscape Then Exit For
      Next i
   End If
   
   ' Ergebnis zurückgeben
   If Level = 1 Then Solve = varResult
   
   Exit Function
Fehlerbehandlung:
' Stop
' Resume Next
End Function

Private Function Combinations( _
   astrTmp() As String, _
   Optional varResult As Variant, _
   Optional strTmp As String, _
   Optional Level As Long = 1 _
   ) As Variant
   Dim i             As Long
   Dim k             As Long
   Dim strChar       As String
   
   If Level = 1 Then
      ' Berechnen, wieviel Möglichkeiten maximal bestehen
      k = 1
      For i = 1 To 9
         k = Len(astrTmp(i)) * k
      Next
      ' Array dementsprechend dimensionieren
      ReDim varResult(k)
      ' Zähler (Element 0) auf Null setzen
      varResult(0) = 0
   End If
   
   For k = 1 To Len(astrTmp(Level))
      ' 1.
Ziffer
      strTmp = Left(strTmp, Level - 1)
      ' Aktuelles Zeichen extrahieren
      strChar = Mid(astrTmp(Level), k, 1)
      
      If InStr(1, strTmp, strChar) = 0 Then
      ' Ziffer noch nicht in der aktuellen Reihe
      
         ' Zum bisherigen String die Ziffer hinzufügen
         strTmp = strTmp & strChar
         If Level = 9 Then
            ' Im höchsten Level hat man eine komplette
            ' Kombination. Zähler um 1 erhöhen
            varResult(0) = varResult(0) + 1
            ' Gefundene Kombination im Array speichern
            varResult(varResult(0)) = strTmp
         Else
            ' Diese Funktion rekursiv aufrufen
            Combinations astrTmp, varResult, strTmp, Level + 1
         End If
      End If
   Next k
   
   If Level = 1 Then
      ' Ergebnisarray kürzen
      ReDim Preserve varResult(varResult(0))
      ' und zurückgeben
      Combinations = varResult
   End If
   
End Function

Die Prozedur SolveMySudoku

Die Prozedur, welches die Quellmatrix mit dem nicht vollständig ausgefüllten Feld übergibt und die zurückgelieferten Lösungen auf dem Tabellenblatt ausgibt, nennt sich SolveMySudoku. Zu Beginn wird darin der Ausgabebereich gelöscht und der aktuelle Zeitpunkt in Form von Millisekunden nach dem Systemstart in einer Variablen gespeichert. Dazu wird die API-Funktion GetTickCount benutzt, die diesen Wert liefert. Zuvor wird über einen Dialog abgefragt, ob alle, oder nur eine einzige Lösung ausgegeben werden soll.

Die anschließend aufgerufene Funktion SolveSudoku liefert ein Variantarray mit den Lösungen zurück. Die Zeitdauer zum Erzeugen, die Anzahl der Lösungen  und die zugehörigen Lösungen werden danach auf dem Tabellenblatt ausgegeben. Um die Ausgabegeschwindigkeit zu erhöhen, wird vor der Ausgabe die Bildschirmaktualisierung aus- und danach wieder eingeschaltet.

Die Funktion SolveSudoku

Zu Beginn werden in einer Schleife alle 9x9 Felder des zweidimensionalen Quellarrays durchlaufen. Ist das aktuelle Feld auf Level 1 ein leerer Variant, wird ein Leerstring eingesetzt. Nun erzeugt man drei Arrays, eines nimmt die Ziffernfolge jeder Zeile, das zweite die Ziffernfolge jeder Spalte und das dritte die Ziffernfolge jedes der neun 3x3 Felder umfassenden Bereiche auf.

Nun durchläuft man in einer weiteren Schleife noch einmal alle leeren Felder des Quellarrays und überprüft dabei, welche Ziffer sich nicht in der aktuellen Reihe, der aktuellen Spalte und dem aktuellen Rechteck befindet. Findet man dabei nur eine einzige Ziffer, wird diese in das Quellarray eingesetzt. Die gleiche Ziffer wird an die Zeichenfolge der Arrays der aktuellen Reihe, der aktuellen Spalte und dem aktuellen Rechteck angehängt. Das Überprüfen wird in einer Do … Loop-Schleife so lange fortgesetzt, bis sich keine einmalige Ziffer mehr finden und einsetzen lässt.

Nun sucht man sich in einer Schleife die Reihe mit den meisten vorhandenen Ziffern. Eine Reihe mit 9 Ziffern muss nicht mehr bearbeitet werden, also überspringt man diese. Aber auch Reihen mit keiner einzigen Ziffer existieren, diese müssen aber in jedem Fall in die weiteren Betrachtungen einbezogen werden.

Die derart ausgewählte Reihe wird durchlaufen und alle möglichen Ziffern der aktuellen Position als String in einem Array gespeichert. Bei einer bereits ausgefüllten Position existiert nur eine mögliche Ziffer, das ist die bereits vorhandene.

Mit Hilfe der Funktion Combinations wird ein Variantarray erzeugt, welches alle möglichen Kombinationen des übergebenen Arrays astrTmp enthält. Diese Kombinationen werden in einer Schleife nacheinander durchlaufen und die jeweiligen Ziffern eingesetzt.

Die nächste noch auszufüllende Reihe wird nach dem Einsetzen der Ziffern einer Kombination in der rekursiv aufgerufenen Funktion SolveSudoku erzeugt, wobei auch auf dieser Stufe alle möglichen Kombinationen nacheinander eingesetzt werden können. Bei der Parameterübergabe wird neben dem bereits mit vorhandenen Ziffern ausgefüllten zweidimensionalen Array auch der um 1 erhöhte Parameter Level übergeben.

So geht es weiter, bis man auf Level 9, also der letzten Reihe angekommen ist. Das Ergebnis wird dann in dem Array varResult gespeichert und beim Erreichen der maximalen Anzahl von Lösungen wird anschließend die Variable blnEscape auf WAHR gesetzt. Aber auch in vorherigen Leveln ist eine Lösung gefunden worden, wenn alle Reihen bereits 9 ausgefüllte Ziffern enthalten. Ist die maximal mögliche Anzahl an Lösungen gefunden worden (1 oder max. 50), werden auch hier nacheinander alle rekursiv aufgerufenen Funktionen verlassen. Auf Level 1 angekommen, wird das Array als Funktionsergebnis zurückgegeben.

Die Funktion Combinations

In dieser Funktion wird ein Array angelegt, welches alle möglichen Kombinationen der als Array übergebenen Ziffer enthält.

Dazu durchläuft man jedes Element des übergebenen Arrays, welches die möglichen Ziffern jeder einzelnen Leerstelle enthält. Im Level 1 werden nacheinander alle Ziffern des ersten Elementes eingesetzt. Nach dem Einsetzen ruft man die gleiche Funktion mit dem um 1 erhöhten Level noch einmal auf setzt nun nacheinander alle Ziffern des zweiten Elementes ein.

Das geht so lange, bis der letzte mögliche Level erreicht ist. Irgendwann sind in diesem Level alle Ziffern eingesetzt worden, nun springt man einen Level zurück, setzt die nächste Ziffer der vorletzten Position ein und springt wieder eine Stufe höher. Dort werden wieder nacheinander alle Ziffern der letzten Position eingesetzt.

Es ist aber glücklicherweise nicht so, dass man nun alle denkbaren Kombinationen durchlaufen muss, ist eine einzusetzende Ziffer bereits in der vorherigen Ziffernfolge vorhanden, wird mit der nächsten fortgefahren. Eine Ziffer wird also erst eingesetzt, wenn diese in der aktuellen Ziffernfolge einmalig ist. Hat man nun alle möglichen Kombinationen im Ergebnisarray varResult gespeichert und befindet man sich im Level 1, wird dieses als Funktionsergebnis zurückgegeben.