Excel好像沒有現成的功能去列，所以就自已來寫了。
一開始用的方法，這個無法設定取幾個元素，是寫死的。很無腦的取幾就跑幾次層迴圈。
後來想說已經花時間寫了，做個一半也是浪費，不如多投入點時間，完整的做成可調的，也好收入自己的工具箱。
原來硬幹的寫法
Sub Lotto()
Cp (10)
End Sub
Function Cp(ByVal N As Integer)
For i = 1 To N
For j = 1 To N
If j <> i Then
For k = 1 To N
If k <> i And k <> j Then
For l = 1 To N
If l <> i And l <> j And l <> k Then
For m = 1 To N
If m <> i And m <> j And m <> k And m <> l Then
For v = 1 To N
If v <> i And v <> j And v <> k And v <> l And v <> m Then
ActiveCell.Value = i & "," & j & "," & k & "," & l & "," & m & "," & v
ActiveCell.Offset(1, 0).Select
End If
Next
End If
Next
End If
Next
End If
Next
End If
Next
Next
End Function
完整的版本是用遞迴（自己呼叫自己）的方式去完成的，這樣就可以隨意去設定取幾了。
另外也加了個設定去決定能不能重複取。
VBA 的程式碼
'想像要取幾就是有幾個Slot要放元素進去
Option Base 1 '強制陣列從1開始
Dim arrNumber() As String '放取出元素的陣列
Dim intSlot As Integer '要取幾個元素、放置位置的總量
Dim intSlotCount As Integer '現在正在放置哪一個Slot
'設定的參數直接填在表中
Sub ArrangementStart()
intSlot = Range("B3").Value
ReDim arrNumber(intSlot)
Range("A1").Activate
Arrangement Range("B1").Value, Range("B2").Value, intSlot, Range("B4").Value
End Sub
Function Arrangement(ByVal S As Integer, ByVal C As Integer, ByVal N As Integer, ByVal R As Integer)
'S：元素起始
'C：元素結束
'N：取幾個元素
'R：是否可重複
Dim Max As Long '要製作的筆數最大值
Dim Slot As Integer '要取幾（判斷總量用）
'檢查製作總量
If R <> 1 Then
Max = N ^ (C - S + 1)
Else
Max = 1
For i = 1 To C - S + 1
Max = Max * i
Next
Slot = 1
For i = 1 To C - S + 1 - N
Slot = Slot * i
Next
Max = Max / Slot
End If
If Max > 1048576 Then
MsgBox "超過Excel列最大值，需修改程式換列執行，不然會當機"
Exit Function
End If
intSlotCount = intSlotCount + 1 '在第幾個位置
For x = S To C '放置每一個元素
If R = 1 Then '如果不允許重複，要進行過濾
For p = LBound(arrNumber) To intSlotCount '從第1個Slot開始檢查到現在放的這個
If CStr(x) = arrNumber(p) Then '如果元素內容與前面的Slot有相同表示該元素被用過了
W = "Null" '更改標記，告知該元素被用過
Exit For '一但有重複就不用往下檢查了，直接跳出迴圈
End If
Next
End If
If W <> "Null" Then '如果標記不等於"Null"
arrNumber(intSlotCount) = x '那就在對應的Slot放入該元素
W = "" '將標記清除，後面做判斷才不會錯誤
If intSlotCount = intSlot Then '如果這兩者相等，代表已經做到最後一個Slot填滿了，就要將內容寫入EXCEL了
For A = LBound(arrNumber) To UBound(arrNumber) '用迴圈組合所有的Slot
strCp = strCp & arrNumber(A) & ","
Next
strCp = Left(strCp, Len(strCp) - 1) '除去最後多餘的分隔符號
ActiveCell.Value = strCp '寫入Excel
ActiveCell.Offset(1, 0).Activate '下移座標，準備下一次寫入
strCp = "" '清空暫存的文字變數
Else
Arrangement S, C, N, R '如果還沒有做到最後一個Slot，那就呼叫相同的Function來做下一個Slot
End If
Else
W = "" '將標記清除，後面做判斷才不會錯誤
End If
Next
'當這個Slot的元素都放置過了，就要移回上一個Slot做下一個元素
arrNumber(intSlotCount) = "" '這時要將目前做的這個Slot清空，不然判斷重複元素時有可能會誤判
intSlotCount = intSlotCount - 1 '在做第幾個位置也要扣回去
End Function
Excel有其限制，例如總數超過 1048576 就寫不下去出問題了，或是組合的數量超過型態的上限等等。不過換行、溢位算起來都是小事，需要的人再自行改造囉～
沒有留言:
張貼留言