| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛

[此贴子已经被作者于2022-11-14 14:36编辑过]

```Private Sub Command1_Click()
Dim i As Integer, j As Integer, k As Integer, l As Integer, s As Integer
s = 0
For i = 0 To 12
For j = i + 1 To 13
For k = j + 1 To 14
For l = k + 1 To 15
s = s + 1
Next
Next
Next
Next
MsgBox s
End Sub```

[此贴子已经被作者于2022-11-14 23:25编辑过]

```Option Explicit

Private Sub printcell(x() As Long, y() As Long, ByVal n As Long)

Static i As Long

Dim r As Long
Dim c As Long
Dim k As Long
Dim w As Long
Dim w1 As Long
Dim w2 As Long
Dim w3 As Long
Dim ox As Long
Dim oy As Long
Dim w4 As Long

w4 = 12
w3 = (w4 \ 2) * 12
ox = 5 * 12
oy = 5 * 12
w1 = 17 * 12
w2 = 15 * 12
w = (17 * n + w4) * 12
r = (i \ 14) * w
c = (i Mod 14) * w

For k = 0 To n - 1

Me.Picture1.Line (ox + c + w3 + y(k) * w1, oy + r + w3 + x(k) * w1)-(ox + c + w3 + y(k) * w1 + w2, oy + r + w3 + x(k) * w1 + w2), &HFF0000, BF

Next

i = i + 1

End Sub

Private Sub printline(ByVal nums As Long, ByVal n As Long)

Dim w As Long
Dim w1 As Long
Dim r As Long
Dim c As Long
Dim ox As Long
Dim oy As Long
Dim x As Long
Dim y As Long
Dim w4 As Long

w4 = 12
r = nums \ 14
c = 14
ox = 5 * 12
oy = 5 * 12
w = (17 * n + w4) * 12

For y = 0 To r + 1

Me.Picture1.Line (ox, oy + y * w)-(ox + 14 * w, oy + y * w), &H80FF&

Next
For x = 0 To c

Me.Picture1.Line (ox + x * w, oy)-(ox + x * w, oy + (r + 1) * w), &H80FF&

Next

End Sub
Private Function isConnected(x() As Long, y() As Long, nums As Long) As Boolean
Dim p As Long
Dim p1 As Long
Dim p2 As Long
Dim pAll() As Long
Dim tmp As Long
Dim flg As Boolean

ReDim pAll(nums - 1)
For p = 0 To nums - 1
pAll(p) = p
Next
p1 = 0
p2 = 1
isConnected = True
Do While p1 < nums - 1
flg = False
p = p1
Do While p >= 0
If Abs(x(pAll(p)) - x(pAll(p2))) <= 1 And _
Abs(y(pAll(p)) - y(pAll(p2))) <= 1 Then
flg = True
Exit Do
End If
p = p - 1
Loop
If flg Then
p1 = p1 + 1
If p1 <> p2 Then
tmp = pAll(p1)
pAll(p1) = pAll(p2)
pAll(p2) = tmp
End If
p2 = p1 + 1
Else
p2 = p2 + 1

If p2 = nums Then
isConnected = False

Exit Do
End If
End If
Loop

End Function

Private Function isOK(x() As Long, y() As Long, ByVal num As Long) As Boolean

Dim i As Long
Dim numx As Long
Dim numy As Long

numx = 0
numy = 0
For i = 0 To num - 1
If x(i) = 0 Then numx = numx + 1
If y(i) = 0 Then numy = numy + 1
Next

If numx = 0 Or numy = 0 Then
isOK = False
Exit Function
End If

isOK = isConnected(x, y, num)

End Function

Private Function number(ByVal num As Long) As Long
Dim x() As Long
Dim y() As Long

ReDim x(num - 1) As Long
ReDim y(num - 1) As Long

number = comb(num, num * num, num, 0, x, y)

printline number, num

End Function

Private Function comb(ByVal num As Long, ByVal n As Long, ByVal k As Long, ByVal i As Long, x() As Long, y() As Long)
x(i) = (n - 1) \ num
y(i) = (n - 1) Mod num
If k = 1 Then
If isOK(x, y, num) Then

comb = comb + 1
printcell x, y, num

End If

If n > k Then comb = comb + comb(num, n - 1, k, i, x, y)

End If

If k > 1 Then

comb = comb + comb(num, n - 1, k - 1, i + 1, x, y)

If n > k Then comb = comb + comb(num, n - 1, k, i, x, y)

End If

End Function
Private Sub Command1_Click()

Label1.Caption = number(4)

End Sub
```

• mrexcel2022-11-25 00:27 送鲜花  5朵

[此贴子已经被作者于2022-11-24 11:23编辑过]

• 8
• 1/1页
• 1