返回列表 上一主題 發帖

[發問] 請教3位數排列組合

[發問] 請教3位數排列組合

想請教前輩們
是否有公式或是用vba的方式
可以讓我在A欄中填入3個數字 可以自動在D欄中排列出各種組合並把編號帶入
3位.png
2019-2-20 13:09

本帖最後由 stillfish00 於 2019-2-21 13:53 編輯

回復 1# eric7765
任意位數排列
  1. Sub Solution()
  2.     Range(Cells(2, "D"), Cells(Rows.Count, "E")).ClearContents  ' Clear result
  3.     If Cells(Rows.Count, "A").End(xlUp).Row < 2 Then Exit Sub   ' Exit if no input
  4.     Dim text As String, id, r
  5.     r = 1
  6.     For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
  7.         text = Cells(i, "A").text
  8.         id = Cells(i, "B").Value
  9.         If Len(text) > 0 Then
  10.             For Each s In GetAllPermutation(text)
  11.                 r = r + 1
  12.                 Cells(r, "D").Value = s
  13.                 Cells(r, "E").Value = id
  14.             Next
  15.         End If
  16.     Next
  17. End Sub
複製代碼
  1. Function GetAllPermutation(ansi_str As String)
  2.     Dim ans: Set ans = CreateObject("scripting.dictionary")
  3.     Dim ch, new_ans
  4.     ans("") = 0
  5.     For i = 1 To Len(ansi_str)
  6.         ch = Mid(ansi_str, i, 1)
  7.         Set new_ans = CreateObject("scripting.dictionary")
  8.         For Each s In ans.keys()
  9.             For j = 0 To Len(s)
  10.                 new_ans(Left(s, j) & ch & Mid(s, j + 1)) = 0
  11.             Next
  12.         Next
  13.         Set ans = new_ans
  14.     Next
  15.     GetAllPermutation = ans.keys()
  16. End Function
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

D2:
=TEXT(SUM((0&MID(INDEX(A:A,INT(ROW(A6)/6)+1),MID({112233,231312,323121},MOD(ROW(A6),6)+1,1),1))*{100,10,1}),"000;;")

E2:
=INDEX(B:B,INT(ROW(A6)/6)+1)&""
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 3# 准提部林


    感謝大大 但有個小問題  可以排除重複的嗎?  比如 366 如果不重複 只會有3種組合 但是照這個公式 會排成6個組合

TOP

回復 2# stillfish00
謝謝s大  對程式方面不熟悉 我貼上 它顯示 沒有定義sub 我附上檔案 可以麻煩 s大幫我看看嗎 感謝

3位數排列組合.rar (15.96 KB)

TOP

回復 2# stillfish00


    感謝s大 您提供的答案 完全符合我需要的 非常感謝

TOP

回復 2# stillfish00

s大~非常感謝您幫忙解決上次的難題   如果改成 數字後面有+號再排列  或者是 在C欄中 如果有任意字再進行排列的話  這樣可行嗎?  麻煩大神有空時能指導一下 感激不盡
222.png
2019-2-27 13:24


排列.rar (15.7 KB)

TOP

回復 7# eric7765


    + 改為 C欄 為 "P"
  1. Sub 排列3()
  2.     Range("D2:E999").ClearContents
  3.     j = 1
  4.     For i = 2 To [a65536].End(xlUp).Row
  5.         If Cells(i, "C").Value = "P" Then
  6.             'For Each k In Array(123, 132, 213, 231, 312, 321)
  7.             For k = 100 To 999
  8.                     a = Cells(i, "A")
  9.                     xA = 7 ^ Mid(a, 1, 1) + 7 ^ Mid(a, 2, 1) + 7 ^ Mid(a, 3, 1)
  10.                     xK = 7 ^ Mid(k, 1, 1) + 7 ^ Mid(k, 2, 1) + 7 ^ Mid(k, 3, 1)
  11.                     If xA = xK Then
  12.                         j = j + 1
  13.                         Cells(j, "D") = k
  14.                         Cells(j, "E") = Cells(i, "B")
  15.                     End If
  16.             Next k
  17.         Else
  18.             j = j + 1
  19.             Cells(j, "D") = Cells(i, "A")
  20.             Cells(j, "E") = Cells(i, "B")
  21.         End If
  22.     Next i
  23. End Sub
複製代碼
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 8# ML089
感謝麻辣前輩的解答~已成功

TOP

本帖最後由 eric7765 於 2019-3-4 14:27 編輯

回復 8# ML089
M大 抱歉 這兩周用起來發現 這程式運行 如果遇到數字裡面有"0"排列出來的組合都會缺少 能麻煩前輩幫忙看看嗎?
0問題.png
2019-3-4 14:25

TOP

        靜思自在 : 人生沒有所有權,只有生命的使用權。
返回列表 上一主題