作者yauhh (喲)
看板Visual_Basic
標題Re: [VBA ] 想請教關於Excel的問題
時間Wed Jan 30 17:50:28 2013
※ 引述《kain1230 (簡單至上)》之銘言：
: 不好意思，最近和學生在討論一個填數問題，目前遇到組合大過龐大，
: 因此人工計算過於繁複，想藉助Excel來解決，
: 我們有16個變量 a,b,c,...,p
: 每個變量都是1到16的正整數，且各自彼此都不同，
: 我們處理得到的方程有以下幾個
: a+b+c+d+e+f+g=49
: 2*b+c+2*d+e+2*f+g=87
: h+i+j=d+e+f
: k+l+m=b+g+f
: n+o+p=b+c+d
用基本的排列方法,我寫的是這樣: 沒有設定一些捷徑跳線之類的優化,
跑了約16小時做到的排列是 1,2, 3, 7, ... 用1.5GHz, 1.99GB的電腦.
不過到此為止還沒找到解.
Sub MyPerm()
Dim a(0 To 15) As Integer
For i = 0 To 15
a(i) = i + 1
Next i
GenPermutation a, 0
End Sub
Sub GenPermutation(Arr() As Integer, base As Integer, Optional RowNum As
Integer = 1)
If base >= UBound(Arr) Then
If check(Arr) = True Then
listNumbers Arr, RowNum
RowNum = RowNum + 1
End If
DoEvents
Else
For i = base To UBound(Arr)
swap Arr(base), Arr(i)
GenPermutation Arr, base + 1, RowNum
swap Arr(base), Arr(i)
Next i
End If
End Sub
Sub swap(a, b)
t = a
a = b
b = t
End Sub
Sub listNumbers(Arr() As Integer, RowNum As Integer)
If LBound(Arr) > UBound(Arr) Then
Else
For i = LBound(Arr) To UBound(Arr)
Sheet1.Cells(RowNum + 1, i + 1) = Arr(i)
Next i
End If
End Sub
Function check(Arr() As Integer) As Boolean
Dim result As Boolean
result = True
result = result And (sum(Arr, 0, 1, 2, 3, 4, 5, 6) = 49)
If result = False Then Exit Function
result = result And (sum(Arr, 1, 1, 2, 3, 3, 4, 5, 5, 6) = 87)
If result = False Then Exit Function
result = result And (sum(Arr, 7, 8, 9) = sum(Arr, 3, 4, 5))
If result = False Then Exit Function
result = result And (sum(Arr, 10, 11, 12) = sum(Arr, 1, 5, 6))
If result = False Then Exit Function
result = result And (sum(Arr, 13, 14, 15) = sum(Arr, 1, 2, 3))
check = result
End Function
Function sum(Arr() As Integer, ParamArray i() As Variant) As Integer
sum = 0
For j = LBound(i) To UBound(i)
sum = sum + Arr(i(j))
Next j
End Function
--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 118.167.54.90
1F：推 ClubT:我覺得可以到 Prob_Solve 板去問問 01/30 22:25
2F：推 EdisonX:奇偶特性應可拿來做一點點加速應用 ? 01/30 23:14
3F：→ EdisonX:ex, (c+e+g)=odd, a+b+d+f=even, ... 01/30 23:14
4F：→ EdisonX:( 還有 a mod 2 == (b+d+f) mod 2 ) 01/30 23:16