Supportnet / Forum / Tabellenkalkulation

hi all hier das zahlenspiel sudoku fuer excel gruss nighty Rem einzufügen Rem alt f11/einfügen/modul Option Explicit Sub Sudoku() Application.ScreenUpdating = False Application.EnableEvents = False Dim zaehler0, zaehler1, zaehler2, zaehler3, zaehler4, ziehung, reihen(9, 9), adressen1(81), _ spalten(9, 9), zwei(81), anzahlziehung, endeindex, allezahlen, gezogen, anzahlziehung0, anzahlziehung1 As Integer Dim schalter As Boolean Range("A4:I12").Borders(xlEdgeLeft).LineStyle = xlContinuous Range("A4:I12").Borders(xlEdgeTop).LineStyle = xlContinuous Range("A4:I12").Borders(xlEdgeBottom).LineStyle = xlContinuous Range("A4:I12").Borders(xlEdgeRight).LineStyle = xlContinuous Range("A4:I12").Borders(xlInsideVertical).LineStyle = xlContinuous Range("A4:I12").Borders(xlInsideHorizontal).LineStyle = xlContinuous Cells(1, 4) = "SUDOKU" Cells(1, 6) = "Vorgegeben 1-60" Range("A1:I12").RowHeight = 20 Range("A1:I12").Font.Size = 18 Range("A4:I12").Interior.ColorIndex = 15 If Cells(2, 6) < 1 Or Cells(2, 6) > 60 Then Cells(2, 6) = 9 zaehler4 = 1 zaehler3 = 9 For zaehler0 = 1 To 9 For zaehler1 = zaehler4 To zaehler3 Cells(zaehler0 + 3, zaehler1 + zaehler2) = zaehler1 Next zaehler1 zaehler3 = zaehler3 - 1 zaehler2 = zaehler2 + 1 Next zaehler0 zaehler4 = 9 zaehler3 = 9 zaehler2 = 1 For zaehler0 = 2 To 9 For zaehler1 = zaehler4 To zaehler3 Cells(zaehler0 + 3, zaehler2) = zaehler1 zaehler2 = zaehler2 + 1 Next zaehler1 zaehler2 = 1 zaehler4 = zaehler4 - 1 Next zaehler0 For zaehler1 = 4 To 12 For zaehler0 = 1 To 9 reihen(zaehler1 - 3, zaehler0) = Cells(zaehler1, zaehler0) Next zaehler0 Next zaehler1 For zaehler1 = 1 To 9 For zaehler0 = 4 To 12 spalten(zaehler0 - 3, zaehler1) = Cells(zaehler0, zaehler1) Next zaehler0 Next zaehler1 anzahlziehung0 = 2 anzahlziehung1 = 9 For zaehler0 = 0 To 10 GoSub ziehung For zaehler1 = 1 To 9 reihen(0, zaehler1) = Cells(zaehler1 + 3, zwei(1)) Cells(zaehler1 + 3, zwei(1)) = Cells(zaehler1 + 3, zwei(0)) Cells(zaehler1 + 3, zwei(0)) = reihen(0, zaehler1) Next zaehler1 Next zaehler0 For zaehler0 = 0 To 10 GoSub ziehung For zaehler1 = 1 To 9 spalten(0, zaehler1) = Cells(zwei(1) + 3, zaehler1) Cells(zwei(1) + 3, zaehler1) = Cells(zwei(0) + 3, zaehler1) Cells(zwei(0) + 3, zaehler1) = spalten(0, zaehler1) Next zaehler1 Next zaehler0 zaehler4 = 0 For zaehler0 = 4 To 12 For zaehler1 = 1 To 9 zaehler4 = zaehler4 + 1 adressen1(zaehler4) = Cells(zaehler0, zaehler1).Address(0, 0) Next zaehler1 Next zaehler0 schalter = True anzahlziehung0 = 81 - Cells(2, 6) anzahlziehung1 = 81 GoSub ziehung Application.EnableEvents = True Application.ScreenUpdating = True End ziehung: Randomize Timer ReDim zuzahl(anzahlziehung1) As Integer ReDim zahl(anzahlziehung1) As Integer endeindex = anzahlziehung1 For allezahlen = 1 To anzahlziehung1 zuzahl(allezahlen) = allezahlen Next allezahlen For ziehung = 1 To anzahlziehung0 gezogen = Int(Rnd * endeindex) + 1 zahl(ziehung) = zuzahl(gezogen) zuzahl(gezogen) = zuzahl(endeindex) endeindex = endeindex - 1 ReDim Preserve zuzahl(endeindex) If schalter = True Then zwei(ziehung) = zahl(ziehung) Range(adressen1(zwei(ziehung))) = "" Range(adressen1(zwei(ziehung))).Interior.ColorIndex = xlNone Else zwei(ziehung - 1) = zahl(ziehung) End If Next ziehung Return End Sub Rem einzufügen Rem alt f11/projektexplorer/Tabelle1 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.EnableEvents = False If Target.Column > 9 Or Target.Row < 2 Or Target.Row > 12 _ Or Cells(Target.Row, Target.Column).Interior.ColorIndex = 15 Then Cells(3, 5).Select End If Application.EnableEvents = True End Sub Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False For zaehler = 1 To 9 If Cells(zaehler, Target.Column) = Cells(Target.Row, Target.Column) And zaehler <> Target.Row Then Cells(Target.Row, Target.Column) = "" End If If Cells(Target.Row, zaehler) = Cells(Target.Row, Target.Column) And zaehler <> Target.Column Then Cells(Target.Row, Target.Column) = "" End If Next zaehler Application.EnableEvents = True End Sub

Hi nighty,

habe versucht den Code einzufügen. Es kommt aber die Meldung
For zaehler = 1 To 9 Variable nicht definiert.

Beschreibe doch bitte mal - auch für einen Anfänger verständlich -, wo man was einfügen muss.

mfg Knubbel

hi knubbel :)

nun hab ich festgestellt ,nachdem ich mir sudoku mal
angeschaut hab das das nicht so ganz regelkonform ist :(
hab noch festgestellt das innerhalb der drei mal drei felder auch keine doppelten vorkommen duerfen,werd das noch aendern,nach dem selben prinzip loesbar,von einer moeglichen loesung werden innerhalb der dreierglieder waagerechte mit waagerechte wie senkrechten mit senkrechten getauscht und so auf andere varianten abgeleitet.

gruss nighty

p.s.
zaehler fehler

dim zaehler as integer

hi all :))
verbesserte variante :)

allerdings in 2 postings da das zeichenlimit wohl erreicht ist

gruss nighty

einzufuegen unter
alt + f11/einfuegen/modul

Global wert As Integer
Option Explicit
Sub Sudoku()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim zaehler0, zaehler1, zaehler3, zaehler4, ziehung, reihen(9, 9), adressen1(81), _
spalten(9, 9), zwei(81), anzahlziehung, endeindex, allezahlen, gezogen, anzahlziehung0, anzahlziehung1 As Integer
Dim schalter As Boolean
Dim zelle As Range
Dim matrix As String
Range("A4:I12").Borders(xlEdgeLeft).LineStyle = xlContinuous
Range("A4:I12").Borders(xlEdgeTop).LineStyle = xlContinuous
Range("A4:I12").Borders(xlEdgeBottom).LineStyle = xlContinuous
Range("A4:I12").Borders(xlEdgeRight).LineStyle = xlContinuous
Range("A4:I12").Borders(xlInsideVertical).LineStyle = xlContinuous
Range("A4:I12").Borders(xlInsideHorizontal).LineStyle = xlContinuous
Range("A1:I12").RowHeight = 20
Range("A1:I12").ColumnWidth = 6
Range("A1:I12").Font.Size = 18
Range("A4:I12").Interior.ColorIndex = 15
Range("E3") = ""
Range("A1") = "SUDOKU"
Range("D1") = " HANDICAP"
matrix = "134678295679452138582193674847315962956827413321964857713246589268539741495781326"
If Cells(2, 5) < 1 Or Cells(2, 5) > 80 Then Cells(2, 5) = 9
For Each zelle In Range("A4:I12")
zaehler3 = zaehler3 + 1
zelle = Mid(matrix, zaehler3, 1)
Next zelle
For zaehler1 = 4 To 12
For zaehler0 = 1 To 9
reihen(zaehler1 - 3, zaehler0) = Cells(zaehler1, zaehler0)
Next zaehler0
Next zaehler1
For zaehler1 = 1 To 9
For zaehler0 = 4 To 12
spalten(zaehler0 - 3, zaehler1) = Cells(zaehler0, zaehler1)
Next zaehler0
Next zaehler1
anzahlziehung0 = 2
anzahlziehung1 = 3
For zaehler3 = 1 To 10
GoSub ziehung
For zaehler1 = 1 To 9
reihen(0, zaehler1) = Cells(zaehler1 + 3, zwei(1))
Cells(zaehler1 + 3, zwei(1)) = Cells(zaehler1 + 3, zwei(0))
Cells(zaehler1 + 3, zwei(0)) = reihen(0, zaehler1)
Next zaehler1
GoSub ziehung
For zaehler1 = 1 To 9
reihen(0, zaehler1) = Cells(zaehler1 + 3, zwei(1) + 3)
Cells(zaehler1 + 3, zwei(1) + 3) = Cells(zaehler1 + 3, zwei(0) + 3)
Cells(zaehler1 + 3, zwei(0) + 3) = reihen(0, zaehler1)
Next zaehler1
GoSub ziehung
For zaehler1 = 1 To 9
reihen(0, zaehler1) = Cells(zaehler1 + 3, zwei(1) + 6)
Cells(zaehler1 + 3, zwei(1) + 6) = Cells(zaehler1 + 3, zwei(0) + 6)
Cells(zaehler1 + 3, zwei(0) + 6) = reihen(0, zaehler1)
Next zaehler1
GoSub ziehung
For zaehler1 = 1 To 9
spalten(0, zaehler1) = Cells(zwei(1) + 3, zaehler1)
Cells(zwei(1) + 3, zaehler1) = Cells(zwei(0) + 3, zaehler1)
Cells(zwei(0) + 3, zaehler1) = spalten(0, zaehler1)
Next zaehler1
GoSub ziehung
For zaehler1 = 1 To 9
spalten(0, zaehler1) = Cells(zwei(1) + 6, zaehler1)
Cells(zwei(1) + 6, zaehler1) = Cells(zwei(0) + 6, zaehler1)
Cells(zwei(0) + 6, zaehler1) = spalten(0, zaehler1)
Next zaehler1
GoSub ziehung
For zaehler1 = 1 To 9
spalten(0, zaehler1) = Cells(zwei(1) + 9, zaehler1)
Cells(zwei(1) + 9, zaehler1) = Cells(zwei(0) + 9, zaehler1)
Cells(zwei(0) + 9, zaehler1) = spalten(0, zaehler1)
Next zaehler1
Next zaehler3
zaehler4 = 0
For zaehler0 = 4 To 12
For zaehler1 = 1 To 9
zaehler4 = zaehler4 + 1
adressen1(zaehler4) = Cells(zaehler0, zaehler1).Address(0, 0)
Next zaehler1
Next zaehler0
schalter = True
anzahlziehung0 = 81 - Cells(2, 5)
anzahlziehung1 = 81
GoSub ziehung
Cells(3, 5).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End
ziehung:
Randomize Timer
ReDim zuzahl(anzahlziehung1) As Integer
ReDim zahl(anzahlziehung1) As Integer
endeindex = anzahlziehung1
For allezahlen = 1 To anzahlziehung1
zuzahl(allezahlen) = allezahlen
Next allezahlen
For ziehung = 1 To anzahlziehung0
gezogen = Int(Rnd * endeindex) + 1
zahl(ziehung) = zuzahl(gezogen)
zuzahl(gezogen) = zuzahl(endeindex)
endeindex = endeindex - 1
ReDim Preserve zuzahl(endeindex)
If schalter = True Then
zwei(ziehung) = zahl(ziehung)
Range(adressen1(zwei(ziehung))) = ""
Range(adressen1(zwei(ziehung))).Interior.ColorIndex = xlNone
Else
zwei(ziehung - 1) = zahl(ziehung)
End If
Next ziehung
Return
End Sub

hi all :)

2 makro

gruss nighty

einzufuegen
alt + f11/projektexplorer/Tabelle1

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Cells(Target.Row, Target.Column).Interior.ColorIndex = 15 Then
wert = Cells(Target.Row, Target.Column)
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim senk, zaehler As Integer
If Cells(Target.Row, Target.Column).Interior.ColorIndex = 15 Then
Cells(Target.Row, Target.Column) = wert
End If
If Target.Row > 3 Then
For zaehler = 1 To 9
If Cells(zaehler + 3, Target.Column) = Cells(Target.Row, Target.Column) And zaehler + 3 <> Target.Row Then
Cells(Target.Row, Target.Column) = ""
End If
If Cells(Target.Row, zaehler) = Cells(Target.Row, Target.Column) And zaehler <> Target.Column Then
Cells(Target.Row, Target.Column) = ""
End If
If WorksheetFunction.Sum(Range(Cells(zaehler + 3, 1), Cells(zaehler + 3, 9))) = 45 Then senk = senk + 1
If WorksheetFunction.Sum(Range(Cells(4, zaehler), Cells(12, zaehler))) = 45 Then senk = senk + 1
If senk = 18 Then Cells(3, 5) = "Sieg"
Next zaehler
End If
Application.EnableEvents = True
End Sub

Wie funktioniert das ganze? Ich drücke also alt +F11 und dann auf neu und füge dort die beiden Texte ein? Werden die in einem Dokument gespeichert und wie speichert man sie überhaupt?

hi all :)

nach neuerstellung einer exceldatei ist das erste makro einzufuegen

alt + f11 öffnet den vbeditor

dort den menuepunkt einfuegen anwaehlen,dann den menuepunkt modul ,in diesen fenster dann das erste makro einfuegen

das zweite makro

im vbeditor unter der menueleiste ist eine iconreihe,dort projektexplorer anwaehlen,jetzt ist links ein fenster aufgegangen,dort tabelle1 anwaehlen mit doppelclick,nun wieder im rechten grossen fenster den code des 2 makros einfuegen

der vbeditor wie das fenster des projektexplorers kann nun geschlossen werden

nun sollte dem ersten makro vielleicht eine taste zugeordnet werden zum starten

im oberen excel menue extras anzuwaehlen,dann makro,dann makros,nun das makro sudoku auswahlen,dann optionen anwahlen und buchstaben zuordnen

datei speichern fertig

nach der eingabe eines geaenderten handicaps makro starten wie auch bei einem neustart des spiels

viel spass bei sudoku

gruss nighty

Danke. Bin ein absoluter n00b was das angeht.

hallo nighty,

bei mir klappt das nicht,
kannste mir das per mail schicken?
jasper111@t-online.de

und danke ...

hi jasper :)

datei ist unterwegs :)

gruss nighty

Vielleicht noch ein kleiner Tipp.
Damit das ganze ein bisschen übersichtlicher ist, könntest du noch die Rahmen um die 9 Felder verstärken.

Range("A4:C6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
.
.
.
.

Hallo Little T
Wo muß man den Code einfügen um die Rahmen zu verstärken?
Gruß Weißnix

• Excel Makro in viele Excel Files exportieren
• hat jemand ahnung von verweisfunktionen in excel
• Excel 2002 Dateien in Excel 2007 für MS Vista Home Premium
• Absturz von Powerpoint UND Excel