网页资讯视频图片知道文库贴吧地图采购
进入贴吧全吧搜索
vba吧 关注：17,093贴子：66,977
  • 52回复贴，共1页

求助关于组合的算法

从26个英文字母里面，选择13个字母，返回所有的组合？如何返回所有的结果？感觉组合比排列还要难。比如从abc里面选择1个字母，那结果就是a，b，c共3种结果。


递归


2026-02-25 00:07:12
广告
不感兴趣
开通SVIP免广告
排列组合里面的排列算法。即对n个元素进行排列，共有多少种排列方式。返回所有排列方式，结果为一维数组。非组合算法。



26取13的结果是不是64764752532480000？提问者和解答者都需要先看目标再想怎么做事，除了技术之外还要看你愿意付出多大时间成本得到这个结果


5楼的真不知道该怎么说你。排列组合，组合c（26，13）=p(26,13)/13!结果是10400600。简单的c（26，25）=c(26,1)=26。你还是先回去复习一下排列组合的知识，以及阶乘的知识吧。还有，上面的是排列的算法，已经说的很清楚了，不是组合算法。这是分享，不是回答


趁吃饭之机，写下给你。 败管是用什么归，还是用循环，计算的量级在那里。
知道怎么算，千万级的数据生成，你有足够的时间等得起看所有结果么？没时间看没办法接收处理，要所有的结果做甚么？
附图结果一个是遍历ABCDE五个字母选三个，另一个是遍历26个字母选13个，我是没勇气看结果，你自己去等状瞧所有结果



补充一下，我要的是像我四楼那样的通用算法，即只要调用该算法，就可进行运算。而不是某人的简单固定的for循环。如果我要100个数里，选98个，那我要写98个for循环？


我的意思是，假如我需要52选26，那我能调用你的方法？我只能另外再写一个sub。而我编的方法，适用于m选n，而不需要再另外写。你这种sub我根本不需要，非要我说得重，你才懂？你这种方法，我还需要你教


2026-02-25 00:01:12
广告
不感兴趣
开通SVIP免广告
“如何返回所有的结果？”这不是一楼你自己说的？搁这扯什么迭代器，生成器呀？没人教你举个例子告诉你查看一千万个结果是扯蛋。这是vba吧扯什么python，等下要不要谈下哲学？


行了，不要老是站在为人师表的角度，去批判别人。你要不就给出具体的算法，而不是上来就说这不行那不行。我自问自答轮不到你来说三道四。我虽然不是老师，但我也是考了跟计算机有关的教师证的。你要是老师，你就去说你的学生去，不要来说我


不是我想要什么，是你在5楼一开始就说什么提问者和解答者需要先看目标再做事，上来就一顿说教，你要是开始直接发你的算法，我不会说你算法有什么问题，但你上来就说教，而且正好提问者和解答者都是我本人，那我肯定要回怼你。2楼里面我也说了下补充是m选n。当然，根本原因是你那习惯性地上来就说教，我可不惯着你


先做人再做事


Option Explicit
'过程输出数组arr中的n个元素所有组合，调用示例：输出组合 Array("A","B","C","D"), 2
'限制：数组从0开始，元素不要超过32
Sub 输出组合(arr, n&)
Dim m&, i&, x$, j&
m = UBound(arr) + 1
If n > m Then Exit Sub
For i = 1 To 2 ^ m - 1
x = WorksheetFunction.Dec2Bin(i, m)
If Len(Replace(x, "0", "")) = n Then
Debug.Print x,
For j = 0 To UBound(arr)
If Mid(x, j + 1, 1) = "1" Then Debug.Print arr(j);
Next j
Debug.Print
End If
Next i
End Sub
Sub test()
输出组合 Array("A", "B", "C", "D"), 2
End Sub


'过程输出，楼主要的，26个字母中任意选定数量后，全部组合的结果，的递归调用。
Sub DiaoHuoJian(lxl, z, mh2002(), VBABar)
If lxl = 0 Then
For i = LBound(mh2002) To UBound(mh2002)
op = op & Chr(64 + mh2002(i))
Next i
Debug.Print op
Exit Sub
End If
For i = VBABar + 1 To z
mh2002(lxl) = i
DiaoHuoJian lxl - 1, z, mh2002, i
DoEvents
Next i
End Sub
Sub test()
n = 5
m = 3
Dim LL()
ReDim LL(1 To m)
DiaoHuoJian m, n, LL, 0
End Sub



2026-02-24 23:55:12
广告
不感兴趣
开通SVIP免广告
我也来凑下热闹
Dim T()
Dim length '要取的元素的总个数
Dim arr(0) '要组合的第一个元素 长度 1
Dim brr() '组合的剩余元素 长度 length-1
Dim tep() '临时数组 存放每次结果
Dim dic As Object '字典,存放最终结果
Dim strjoin ' t()数组元素拼接而成 例如 abcdefg
Sub ee()
Set dic = CreateObject("scripting.dictionary")
length = 4
T = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j")
' T = Array("a", "b", "c", "d", "e", "f")
strjoin = Join(T, "")
' MsgBox InStr(strjoin, "e")
ReDim tep(0 To 0)
For i = 0 To UBound(T) - length + 1
DG1 = 0
arr(0) = T(i)
tep(0) = arr(0)
ReDim brr(0 To length - 2)
For tt = LBound(brr) To UBound(brr)
tt1 = tt1 + 1
brr(tt) = T(tt1)
'Debug.Print brr(tt)
Next
tt1 = tt1 - UBound(brr)
Call DG(tep(), brr())
Next
For Each e In dic
Debug.Print e
Next
Debug.Print "合计组合数："; dic.Count
End Sub
Sub DG(arr1, brr1) '递归主程序
Dim str, str1 As String, crr()
K1 = -1
For i = 0 To UBound(brr1)
str = brr1(i)
str1 = str1 + str
Next
dic.Add arr1(0) & str1, arr1(0) & str1
Debug.Print arr1(0) & str1
Select Case aa(brr1)
Case Is = 1
Exit Sub
Case Is = 2
ReDim crr(0 To length - 2)
'如果brr1最后第二位和最后1位 未相邻 例 6取 4 110101 1011001
If InStr(strjoin, brr1(UBound(brr1))) - InStr(strjoin, brr1(UBound(brr1) - 1)) > 1 Then
For i = 0 To UBound(brr1) - 2
crr(i) = brr1(i)
Next
crr(UBound(crr()) - 1) = T(InStr(strjoin, brr1(UBound(brr1) - 1)))
crr(UBound(crr())) = T(InStr(strjoin, brr1(UBound(brr1) - 1)) + 1)
'如果brr1最后第二位是brr1 第二位 且 brr1最后2位已到达数组t最后 例 6取 4 110011 101011
ElseIf brr1(UBound(brr1) - 1) = brr1(1) And InStr(strjoin, brr1(UBound(brr1))) - InStr(strjoin, brr1(UBound(brr1) - 1)) = 1 Then
For i = 0 To UBound(crr)
crr(i) = T(InStr(strjoin, brr1(0)) + i)
Next
'如果brr1最后第二位不是brr1 第二位 且 brr1最后2位已到达数组t最后 例 6取5 111011 7取5 1110011 1101011
ElseIf brr1(UBound(brr1) - 1) <> brr1(1) And InStr(strjoin, brr1(UBound(brr1))) - InStr(strjoin, brr1(UBound(brr1) - 1)) = 1 Then
For i = UBound(brr1) To LBound(brr1) Step -1
If InStr(strjoin, brr1(i)) - InStr(strjoin, brr1(i - 1)) > 1 Then
For j = O To i - 2
crr(j) = brr1(j)
Next
For K = i - 1 To UBound(crr)
K1 = K1 + 1
crr(K) = T(InStr(strjoin, brr1(i - 1)) + K1)
Next
Exit For
Else
End If
Next
Else
End If
Call DG(tep(), crr())
Case Is = 3
ReDim crr(0 To length - 2)
For i = 0 To UBound(brr1) - 1
crr(i) = brr1(i)
Next
crr(UBound(crr())) = T(InStr(strjoin, brr1(UBound(brr1))))
Call DG(tep(), crr())
Case Else
End Select
End Sub
Function aa(arr2) '判断 当前元素位置
For i = UBound(T) - length + 2 To UBound(T)
L1 = T(i)
L = L + L1
Next
For i = O To UBound(arr2)
K1 = arr2(i)
K = K + K1
Next
If L = K Then '已组合到最后 6选3 100011 OR 6选4 100111 输出 退出递归
aa = 1
ElseIf T(UBound(T)) = arr2(UBound(arr2)) Then '元素未全部移到最后 6选3 110001 OR 6选4 101101 brr第一位需往后选,剩余位数按顺序选取
aa = 2
ElseIf T(UBound(T) - length + 2) <> arr2(0) And T(UBound(T)) <> arr2(UBound(arr2)) Then '未全部移到最后 6选3 11100 OR 11010 brr前几位不变，最后一位后移一位选取
aa = 3
Else
End If
End Function


扫二维码下载贴吧客户端

下载贴吧APP
看高清直播、视频！
  • 52回复贴，共1页
分享到: