Schachrätsel mit VBA lösen

Forumthread: Schachrätsel mit VBA lösen

26.08.2004 13:41:29

Remo

Hallo Freunde des Excels
Es gibt doch dieses bekannte Schachrätsel: "Wie bringe ich acht Damen auf ein
Schachbrett, ohne dass eine die andere Schlagen darf?"
Soll heissen: Keine Horizontale, Vertikale oder Diagonale darf durch mehr als eine Dame besetzt sein.
Hat jemand von euch eine Idee, wie sich das per VBA lösen liesse?
Bin gespannt...
Gruss Remo

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Schachrätsel mit VBA lösen

Andreas

Brute Force
1. Schleife von 1 bis 8
2a. Schleife von 1 bis 8
2b. Schleife von 1 bis 8
Für jede Stelle auf dem Brett, die sich ergibt aus 2a und 2b
Ist die Stelle schon besetzt?
Ja: geh zu next von 2b
Nein: dann hier weiter
Jetzt schleifen horizontal, vertikal und diagonal von Stelle 2a 2b weg in beiden Richtungen bis Ende des Brettes erreicht wird und siehe nach, ob ein besetztes Feld gefunden wird.
Ja: geh zu next von 2b
Nein: Position besetzen
Sind wir bei Dame 8 sprich ist Schleifenvariable 1 gleich 8
Nein: geh zu Next von Schleife 1
Ja: Ausgabe: Ergebnis gefunden
Position von Dame mit Nummer Schleife-1 freigeben
next 2b
next 2a
position von der Dame mit Nummer Schleife-1 freigeben
next 1
Ausgabe "keine weitere lösungen"
So ungefähr

AW: Schachrätsel mit VBA lösen

Remo

Habe schon eine Lösung, aber die überzeugt mich noch nicht so richtig.
Ich denke es sollte auch mit weniger Code möglich sein.


Sub Acht_richtige()
Application.ScreenUpdating = False
Schleife = 1
Do Until Schleife = 1000000
Range("A1:H8").ClearContents
For i = 1 To 8
Cells(i, Int((8 * Rnd) + 1)) = "X"
Next i
Kontrolle = ""
For z = 1 To 8
Kontrolle = Kontrolle & Application.WorksheetFunction.CountIf(Columns(z), "X")
If Application.WorksheetFunction.CountIf(Columns(z), "X") <> 1 Then Exit For
Next z
If Kontrolle = "11111111" Then
For Each Zelle In Range("A1:H8")
If Zelle = "X" Then
Spalte = Zelle.Column
Zeile = Zelle.Row
Do Until Spalte > 7 Or Zeile > 7
Spalte = Spalte + 1
Zeile = Zeile + 1
If Cells(Zeile, Spalte) = "X" Then GoTo weiter
Loop
End If
Next
For Each Zelle In Range("A1:H8")
If Zelle = "X" Then
Spalte = Zelle.Column
Zeile = Zelle.Row
Do Until Spalte < 2 Or Zeile > 7
Spalte = Spalte - 1
Zeile = Zeile + 1
If Cells(Zeile, Spalte) = "X" Then GoTo weiter
Loop
End If
Next
End
End If
weiter:
Schleife = Schleife + 1
Loop
Application.ScreenUpdating = True
End Sub

Aaaaaaarrrrgggghhhhhh

Andreas

Da war irgendetwas mit einer unendliche Anzahl von Affen mit unendlich vielen Schreibmaschinen, die ein Shakespeare-Werk schreiben sollten. Oder?
Die angegebene Lösung schmeisst acht Damen auf das Brett und schaut was rauskommt.
Mensch - ist mir schlecht ;-)

AW: Aaaaaaarrrrgggghhhhhh

Remo

Es fällt kein Meister vom Himmel... :-)
Aber bringst Du es mit weniger Code hin?

AW: Aaaaaaarrrrgggghhhhhh

Andreas

- Aber bringst Du es mit weniger Code hin?
Keine Ahnung. Und ich schätze das Merkmal "weniger Code" als ziemlich unwichtig.

AW: Schachrätsel mit VBA lösen

Georg

Stichwort "Backtracking"/Rekursion.
Findet man Lösungsansätze bei google wenn man nach "acht Damen Schach Problem" oder einen von den obigen stichwörtern sucht. In welcher Sprache man das jetzt umsetzt ist was anderes.
(Hab leider nicht die Zeit im Moment das mal in VBA zu probieren)
Gruss
Georg

rekursive Lösung

IngoG

Hallo Remo,
schau Dir mal die angehängte Datei an.
https://www.herber.de/bbs/user/10185.xls
in K1 kannst Du einen Anfangsstring eingeben, von dem ab gesucht wird um mehr als eine lösung zu finden...
Ich habe das problem rekursiv gelöst.
ich suche einen string mit der länge 8, in dem die stellen die Zeilen festlegen und die jeweilige ziffer die spalte in dieser zeile.
ausgehend von einem Startstring (im normalfall "") probiere ich alle möglichkeiten aus, in dem ich jeweils überprüfe, ob mein akt. string noch den regeln entspricht (mit der Function Kontrolle())
ist dies der Fall setzte ich in die nächste zeile einen neuen stein in die spalte 1.
ist dies nicht der fall, so setzte ich in der aktuellen zeile den stein ein feld weiter nach rechts.
wird der stein so aus dem feld geschoben (also auf spalte 9) so nehem ich den stein wieder vom feld und gehe ich in der zeile vorher eine position weiter nach rechts...
mit dem neuen string arbeite ich dann wieder weiter.
solltest du fragen haben, melde Dich einfach nochmal
Gruß Ingo
PS eine Rückmeldung wäre nett...

AW: rekursive Lösung die 2.

ingoG

Hallo nochmal,
hab wohl einmal nicht abgespeichert,
hier also die lösung mit dem Startstring in K1
https://www.herber.de/bbs/user/10186.xls
Gruß Ingo

Beliebteste Forumthreads (12 Monate)

Forumthread: Schachrätsel mit VBA lösen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Schachrätsel mit VBA lösen

Forumthread: Schachrätsel mit VBA lösen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread