Dim X(16) Private Sub Form_Load() For i = 1 To 16: X(i) = 0: Next n = 1
X: '--------------------------- If n >= 1 Then X(n) = X(n) + 1 Else GoTo X If X(n) > 16 Then X(n) = 0: n = n - 1: GoTo X If ch1(n) = False Then GoTo X '-------------------------------- If n = 4 And ch1234() = False Then GoTo X If n = 8 And ch5678() = False Then GoTo X If n = 12 And ch9012() = False Then GoTo X If n < 16 Then n = n + 1: GoTo X If mix() = False Then X(n) = 0: n = n - 1: GoTo X
Open App.Path & "\out.txt" For Output As #1 For i = 1 To 4 ans = "" For j = 0 To 3 ans = ans & X(i + (j * 4)) & " " Next Print #1, ans Next Close End Sub
Function ch1(a) As Boolean ch = True For i = 1 To a - 1 If X(i) = X(a) Then ch = False Next ch1 = ch End Function
Function ch1234() As Boolean For i = 1 To 4: s = s + X(i): Next If s <> 34 Then ch1234 = False Else ch1234 = True End Function Function ch5678() As Boolean For i = 5 To 8: s = s + X(i): Next If s <> 34 Then ch5678 = False Else ch5678 = True End Function Function ch9012() As Boolean For i = 9 To 12: s = s + X(i): Next If s <> 34 Then ch9012 = False Else ch9012 = True End Function Function mix() As Boolean Dim ch As Boolean ch = True
If X(13) + X(14) + X(15) + X(16) <> 34 Then ch = False If X(1) + X(5) + X(9) + X(13) <> 34 Then ch = False If X(2) + X(6) + X(10) + X(14) <> 34 Then ch = False If X(3) + X(7) + X(11) + X(15) <> 34 Then ch = False If X(4) + X(8) + X(12) + X(16) <> 34 Then ch = False If X(1) + X(6) + X(11) + X(16) <> 34 Then ch = False If X(4) + X(7) + X(10) + X(13) <> 34 Then ch = False
Dim X(16) As Integer Dim sum Private Sub Form_Load() n = 1 sum = 0 For i = 1 To 16 sum = sum + i Next i sum = sum / 4
AA: X(n) = X(n) + 1 If X(n) > 16 Then X(n) = 0: n = n - 1: GoTo AA If n < 1 Then GoTo BB
'判斷此格有無與前幾格重複 For i = 1 To n - 1 If X(i) = X(n) Then GoTo AA Next i '---------------------------- '判斷是否符合條件 '輸入完4格，判斷1234格之合 If n = 4 And (X(1) + X(2) + X(3) + X(4)) <> sum Then GoTo AA If n = 8 And (X(5) + X(6) + X(7) + X(8)) <> sum Then GoTo AA If n = 12 And (X(9) + X(10) + X(11) + X(12)) <> sum Then GoTo AA If n = 16 Then If Check() = True Then GoTo BB Else X(n) = 0 n = n - 1 GoTo AA End If End If
If n < 16 Then n = n + 1: GoTo AA
BB: ans = ""
Open App.Path & "\out.txt" For Output As #1 For i = 1 To 16 Print #1, X(i), If i Mod 4 = 0 Then Print #1, Next i Close End Sub
Function Check() As Boolean P = True If (X(13) + X(14) + X(15) + X(16)) <> sum Then P = False: GoTo cc If (X(1) + X(5) + X(9) + X(13)) <> sum Then P = False: GoTo cc If (X(2) + X(6) + X(10) + X(14)) <> sum Then P = False: GoTo cc If (X(3) + X(7) + X(11) + X(15)) <> sum Then P = False: GoTo cc If (X(4) + X(8) + X(12) + X(16)) <> sum Then P = False: GoTo cc If (X(4) + X(7) + X(10) + X(13)) <> sum Then P = False: GoTo cc If (X(1) + X(6) + X(11) + X(16)) <> sum Then P = False: GoTo cc cc: Check = P End Function
Dim X(16)
回覆刪除Private Sub Form_Load()
For i = 1 To 16: X(i) = 0: Next
n = 1
X: '---------------------------
If n >= 1 Then X(n) = X(n) + 1 Else GoTo X
If X(n) > 16 Then X(n) = 0: n = n - 1: GoTo X
If ch1(n) = False Then GoTo X
'--------------------------------
If n = 4 And ch1234() = False Then GoTo X
If n = 8 And ch5678() = False Then GoTo X
If n = 12 And ch9012() = False Then GoTo X
If n < 16 Then n = n + 1: GoTo X
If mix() = False Then X(n) = 0: n = n - 1: GoTo X
Open App.Path & "\out.txt" For Output As #1
For i = 1 To 4
ans = ""
For j = 0 To 3
ans = ans & X(i + (j * 4)) & " "
Next
Print #1, ans
Next
Close
End Sub
Function ch1(a) As Boolean
ch = True
For i = 1 To a - 1
If X(i) = X(a) Then ch = False
Next
ch1 = ch
End Function
Function ch1234() As Boolean
For i = 1 To 4: s = s + X(i): Next
If s <> 34 Then ch1234 = False Else ch1234 = True
End Function
Function ch5678() As Boolean
For i = 5 To 8: s = s + X(i): Next
If s <> 34 Then ch5678 = False Else ch5678 = True
End Function
Function ch9012() As Boolean
For i = 9 To 12: s = s + X(i): Next
If s <> 34 Then ch9012 = False Else ch9012 = True
End Function
Function mix() As Boolean
Dim ch As Boolean
ch = True
If X(13) + X(14) + X(15) + X(16) <> 34 Then ch = False
If X(1) + X(5) + X(9) + X(13) <> 34 Then ch = False
If X(2) + X(6) + X(10) + X(14) <> 34 Then ch = False
If X(3) + X(7) + X(11) + X(15) <> 34 Then ch = False
If X(4) + X(8) + X(12) + X(16) <> 34 Then ch = False
If X(1) + X(6) + X(11) + X(16) <> 34 Then ch = False
If X(4) + X(7) + X(10) + X(13) <> 34 Then ch = False
mix = ch
End Function
-------------
要跑蠻久的~.~
輸出:
1 12 13 8
2 14 7 11
15 3 10 6
16 5 4 9
Dim X(16) As Integer
回覆刪除Dim sum
Private Sub Form_Load()
n = 1
sum = 0
For i = 1 To 16
sum = sum + i
Next i
sum = sum / 4
AA:
X(n) = X(n) + 1
If X(n) > 16 Then X(n) = 0: n = n - 1: GoTo AA
If n < 1 Then GoTo BB
'判斷此格有無與前幾格重複
For i = 1 To n - 1
If X(i) = X(n) Then GoTo AA
Next i
'----------------------------
'判斷是否符合條件
'輸入完4格，判斷1234格之合
If n = 4 And (X(1) + X(2) + X(3) + X(4)) <> sum Then GoTo AA
If n = 8 And (X(5) + X(6) + X(7) + X(8)) <> sum Then GoTo AA
If n = 12 And (X(9) + X(10) + X(11) + X(12)) <> sum Then GoTo AA
If n = 16 Then
If Check() = True Then
GoTo BB
Else
X(n) = 0
n = n - 1
GoTo AA
End If
End If
If n < 16 Then n = n + 1: GoTo AA
BB:
ans = ""
Open App.Path & "\out.txt" For Output As #1
For i = 1 To 16
Print #1, X(i),
If i Mod 4 = 0 Then Print #1,
Next i
Close
End Sub
Function Check() As Boolean
P = True
If (X(13) + X(14) + X(15) + X(16)) <> sum Then P = False: GoTo cc
If (X(1) + X(5) + X(9) + X(13)) <> sum Then P = False: GoTo cc
If (X(2) + X(6) + X(10) + X(14)) <> sum Then P = False: GoTo cc
If (X(3) + X(7) + X(11) + X(15)) <> sum Then P = False: GoTo cc
If (X(4) + X(8) + X(12) + X(16)) <> sum Then P = False: GoTo cc
If (X(4) + X(7) + X(10) + X(13)) <> sum Then P = False: GoTo cc
If (X(1) + X(6) + X(11) + X(16)) <> sum Then P = False: GoTo cc
cc:
Check = P
End Function
out.txt
1 2 15 16
12 14 3 5
13 7 10 4
8 11 6 9