Option
Explicit
Dim
zielmatrix()
Dim
summen()
Dim
zahl
As
Long
Sub
matrix()
Dim
zeile
As
Long
Dim
spalte
As
Long
Dim
start
Dim
ende
Application.ScreenUpdating =
False
start = Now
ReDim
zielmatrix(1
To
11, 1
To
11)
For
spalte = 1
To
11
zielmatrix(11, spalte) =
"x"
Next
spalte
summen = Array(0, 7, 17, 2, 7, 2, 15, 4, 13, 1, 3, 19)
For
zahl = 18
To
1
Step
-1
If
zahl >= 10
Then
If
zahl_eintragen(Right(zahl, 1), 2)
Then
Else
zahl_zurück
End
If
Else
If
zahl_eintragen(zahl, 1)
Then
Else
zahl_zurück
End
If
End
If
Next
zahl
If
zahl > 0
Then
MsgBox
"keine Lösung gefunden"
Exit
Sub
End
If
For
zeile = 1
To
10
For
spalte = 1
To
11
If
zielmatrix(zeile, spalte) =
"x"
Then
zielmatrix(zeile, spalte) =
""
Next
spalte
Next
zeile
ActiveSheet.Range(
"B1:L11"
) = zielmatrix
ende = Now
MsgBox
"fertig!"
& Chr(10) &
"Dauer: "
& Format(ende - start,
"ss"
) &
" Sekunden"
Application.ScreenUpdating =
True
End
Sub
Function
zahl_eintragen(zahl1
As
Long
, stellen
As
Long
)
As
Boolean
Dim
fertig
As
Boolean
Dim
zeile
As
Long
Dim
spalte
As
Long
Dim
klein
As
Long
Dim
i
As
Long
Dim
anzx
As
Long
fertig =
False
klein =
False
For
zeile = 10
To
1
Step
-1
For
spalte = 11
To
1
Step
-1
If
zielmatrix(zeile, spalte) =
""
Then
If
zeile = 9
And
zahl = 18
Then
MsgBox
"Fehler"
, ,
"Fehler"
End
End
If
If
((zeile - 1) * 11 + spalte) < (2 * zahl)
Then
klein =
True
End
If
If
klein =
False
And
zeile < 10
Then
anzx = 0
For
i = 1
To
11
If
zielmatrix(zeile + 1, i) =
"x"
Then
anzx = anzx + 1
Next
If
anzx = 11
Then
klein =
True
End
If
If
zahl1 <= summen(spalte)
And
zielmatrix(zeile + 1, spalte) =
"x"
And
klein =
False
Then
If
stellen = 2
Then
If
spalte > 1
Then
If
summen(spalte - 1) > 0
And
zielmatrix(zeile + 1, spalte - 1) =
"x"
Then
zahl_eintragen =
True
summen(spalte) = summen(spalte) - zahl1
summen(spalte - 1) = summen(spalte - 1) - 1
zielmatrix(zeile, spalte) = zahl1
zielmatrix(zeile, spalte - 1) = 1
If
spalte > 2
Then
zielmatrix(zeile, spalte - 2) =
"x"
fertig =
True
Else
zielmatrix(zeile, spalte) =
"x"
End
If
Else
zahl_eintragen =
False
fertig =
True
End
If
Else
zahl_eintragen =
True
summen(spalte) = summen(spalte) - zahl1
zielmatrix(zeile, spalte) = zahl1
If
spalte > 1
Then
zielmatrix(zeile, spalte - 1) =
"x"
fertig =
True
End
If
Else
zielmatrix(zeile, spalte) =
"x"
End
If
End
If
If
fertig =
True
Then
Exit
For
Next
spalte
If
fertig =
True
Then
Exit
For
Next
zeile
End
Function
Sub
zahl_zurück()
Dim
fertig
As
Boolean
Dim
erster
As
Boolean
Dim
zeile
As
Long
Dim
spalte
As
Long
Dim
neuzahl
As
Long
erster =
False
fertig =
False
For
zeile = 1
To
10
For
spalte = 1
To
11
If
zielmatrix(zeile, spalte) <>
""
Then
If
erster =
False
Then
If
IsNumeric(zielmatrix(zeile, spalte))
Then
summen(spalte) = summen(spalte) + zielmatrix(zeile, spalte)
neuzahl = zielmatrix(zeile, spalte)
zielmatrix(zeile, spalte) =
"x"
If
spalte < 11
Then
If
IsNumeric(zielmatrix(zeile, spalte + 1))
Then
summen(spalte + 1) = summen(spalte + 1) + zielmatrix(zeile, spalte + 1)
neuzahl = 10 +
CLng
(zielmatrix(zeile, spalte + 1))
zielmatrix(zeile, spalte + 1) =
"x"
End
If
End
If
fertig =
True
Else
zielmatrix(zeile, spalte) =
""
End
If
erster =
True
Else
If
IsNumeric(zielmatrix(zeile, spalte))
Then
summen(spalte) = summen(spalte) + zielmatrix(zeile, spalte)
neuzahl = zielmatrix(zeile, spalte)
zielmatrix(zeile, spalte) =
"x"
If
spalte < 11
Then
If
IsNumeric(zielmatrix(zeile, spalte + 1))
Then
summen(spalte + 1) = summen(spalte + 1) + zielmatrix(zeile, spalte + 1)
neuzahl = 10 +
CLng
(zielmatrix(zeile, spalte + 1))
zielmatrix(zeile, spalte + 1) =
"x"
End
If
End
If
fertig =
True
Else
zielmatrix(zeile, spalte) =
""
End
If
End
If
End
If
If
fertig =
True
Then
Exit
For
Next
spalte
If
fertig =
True
Then
Exit
For
Next
zeile
zahl = neuzahl + 1
End
Sub