Anzeige
Archiv - Navigation
472to476
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
472to476
472to476
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Schachrätsel mit VBA lösen

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

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
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

Anzeige
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
Anzeige
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...
Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige