返回列表 上一主題 發帖

[發問] 排列組合題目(1~10的所有組合)有大大能破解嗎?

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-7-17 16:49 | 只看該作者

[發問] 排列組合題目(1~10的所有組合)有大大能破解嗎?

各位先進大家好
小弟最近在研究排列組合
想請教各位大大
若想要從1~10個號碼裡面跑完所有的排列組合
10取1~10取10
一共會產生出1,023個組合,算法如下方
For I = 1 To 10
    x = x + Application.Combin(10, I)
Next
但這1,023個組合要如何才能產生出來呢?
請問哪位大大有辦法破解嗎?
收藏 分享
PKKO

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
2#
發表於 2016-7-18 11:18 | 只看該作者
小弟提供拙見，下列是10取4的方式
但要如何從10取1到10取10?
總不能寫了下方的程式碼,然後寫十遍吧= =?
  1. Sub 排列組合_不重複()
  2. Dim ar(), br(), x&, y&, z&, n&
  3. ReDim br(1 To Application.Combin(10, 4), 1 To 4)
  4. ReDim ar(1 To 10, 1 To 1)
  5. For i = 1 To 10
  6.     ar(i, 1) = i
  7. Next
  8. For w = 1 To UBound(ar) - 3
  9.     For x = w + 1 To UBound(ar) - 2
  10.         For y = x + 1 To UBound(ar) - 1
  11.             For z = y + 1 To UBound(ar)
  12.                 n = n + 1
  13.                 br(n, 1) = ar(w, 1)
  14.                 br(n, 2) = ar(x, 1)
  15.                 br(n, 3) = ar(y, 1)
  16.                 br(n, 4) = ar(z, 1)
  17.             Next
  18.         Next
  19.     Next
  20. Next
  21. Range("a2").Resize(n, 4) = br
  22. MsgBox "操作完成,共生成" & n & "個組合"
  23. End Sub
複製代碼
PKKO

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
3#
發表於 2016-7-18 15:12 | 只看該作者
本帖最後由 stillfish00 於 2016-7-18 15:15 編輯

回復 2# PKKO
1~1023 用二進位看, 各bit  bit=1為取 , bit=0為不取
  1. Sub ListCombination()
  2.     Dim pools, poolCnt As Integer
  3.     pools = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
  4.     poolCnt = UBound(pools) - LBound(pools) + 1
  5.    
  6.     Dim i, j, arResult
  7.     ReDim arResult(1 To 2 ^ poolCnt - 1, 1 To 10)
  8.     For i = 1 To 2 ^ poolCnt - 1
  9.         For j = 0 To poolCnt - 1
  10.             If i And 2 ^ j Then arResult(i, j + 1) = pools(j)
  11.         Next
  12.     Next
  13.     Sheets.Add.[a1].Resize(UBound(arResult), UBound(arResult, 2)) = arResult
  14. End Sub
複製代碼
1

評分人數

表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
4#
發表於 2016-7-18 17:07 | 只看該作者
回復 3# stillfish00


    S大您好,非常感謝您的協助
已經多次得到您的幫忙，感激不盡!
程式碼小弟先拜讀一下^_^
PKKO

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
5#
發表於 2016-7-19 09:13 | 只看該作者
回復 3# stillfish00
更正一下
ReDim arResult(1 To 2 ^ poolCnt - 1, 1 To 10)
應該為
ReDim arResult(1 To 2 ^ poolCnt - 1, 1 To poolCnt)
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
6#
發表於 2016-7-19 11:49 | 只看該作者
回復 5# stillfish00


沒問題!
那邊是預先建立放置資料的陣列
感謝您的細心!
PKKO

TOP

        靜思自在 : 稻穗結得越飽滿，越會往下垂，一個人越有成就，就要越有謙沖的胸襟。
返回列表 上一主題