[已解决]请教一个数字排列组合的问题

QCW911

请教两个问题
问题1：
4个字母 选择3个拼成一个字符串
可以拼成
ABC
ABD
ACD
BCD

那么10个数选6个拼成字符串
又是多少呢
请大侠帮忙写一个通用函数
'@@@@@@@@@@@@@@@@@@@@@@@@@@
问题2：字符串ABC三个元素
组合
结果为

ABC

ACB

BAC

BCA

CAB

CBA

位置不同也算不同
那么5个元素组合出来的结果呢
又是多少呢
请大侠帮忙写一个通用函数

最佳答案

月排行榜 / 总排行榜

JX_shangrila

2016-6-17 21:19

递归代码不是那么容易，看过几位大师的代码。你的二个问题蓝版和香川大师都写过很好的代码，在我以前学习和消化的基础上，略作修改。第一个问题是过程abc，第二个问题是过程abcd。
Dim brr(1 To 1000, 1 To 1)
Dim arr, k%, n%, sj
Sub abc()
   k = 0:   Erase brr
   arr = Range("a2:a" & Range("a65536").End(xlUp).Row)
   dg arr, 1, "", 0
   Range("c2").Resize(1000) = ""
   Range("c2").Resize(k) = brr
End Sub
Sub dg(arr, t, str, y)
    If y = [b2] Then k = k + 1:brr(k, 1) = str:Exit Sub   
    If t < UBound(arr) + 1 Then
       dg arr, t + 1, str & arr(t, 1), y + 1
       dg arr, t + 1, str, y
    End If
End Sub

Sub abcd()
    k = 0: n = [b2]: Erase brr
    arr = Range("a2:a" & Range("a65536").End(xlUp).Row)
    Call dg1(arr, 0, "", 0)
    Range("c2").Resize(1000) = ""
    Range("c2").Resize(k) = brr
End Sub
Sub dg1(arr, t, str, y)
    If y = n Then sj = Split(str, ","): Call dg2("", 0, 1): Exit Sub
    For j = t + 1 To UBound(arr)
        Call dg1(arr, j, str & "," & arr(j, 1), y + 1)
    Next
End Sub
Sub dg2(str$, i%, t%)
    str = Replace(str, " ", "")
    If t > n And Len(Trim(str)) = n Then k = k + 1: brr(k, 1) = str
    If t <= n Then Call dg2(str & sj(t), t, t + 1)
    If i > 1 Then Call dg2(Right(str, 1) & Left(str, (t - 2)), i - 1, t)
End Sub

跳转到最佳答案楼层

爱疯

组合算法以及结果输出
http://www.excelpx.com/thread-333408-1-1.html


楼主也是学习通用写法？我还木学会

爱疯

爱疯 发表于 2016-6-16 16:57
组合算法以及结果输出
http://www.excelpx.com/thread-333408-1-1.html

我只是提供了一个学习贴，我还没学会。
最佳还是留给解决你的问题的朋友吧！谢谢

JX_shangrila

递归代码不是那么容易，看过几位大师的代码。你的二个问题蓝版和香川大师都写过很好的代码，在我以前学习和消化的基础上，略作修改。第一个问题是过程abc，第二个问题是过程abcd。
Dim brr(1 To 1000, 1 To 1)
Dim arr, k%, n%, sj
Sub abc()
   k = 0:   Erase brr
   arr = Range("a2:a" & Range("a65536").End(xlUp).Row)
   dg arr, 1, "", 0
   Range("c2").Resize(1000) = ""
   Range("c2").Resize(k) = brr
End Sub
Sub dg(arr, t, str, y)
    If y = [b2] Then k = k + 1:brr(k, 1) = str:Exit Sub   
    If t < UBound(arr) + 1 Then
       dg arr, t + 1, str & arr(t, 1), y + 1
       dg arr, t + 1, str, y
    End If
End Sub

Sub abcd()
    k = 0: n = [b2]: Erase brr
    arr = Range("a2:a" & Range("a65536").End(xlUp).Row)
    Call dg1(arr, 0, "", 0)
    Range("c2").Resize(1000) = ""
    Range("c2").Resize(k) = brr
End Sub
Sub dg1(arr, t, str, y)
    If y = n Then sj = Split(str, ","): Call dg2("", 0, 1): Exit Sub
    For j = t + 1 To UBound(arr)
        Call dg1(arr, j, str & "," & arr(j, 1), y + 1)
    Next
End Sub
Sub dg2(str$, i%, t%)
    str = Replace(str, " ", "")
    If t > n And Len(Trim(str)) = n Then k = k + 1: brr(k, 1) = str
    If t <= n Then Call dg2(str & sj(t), t, t + 1)
    If i > 1 Then Call dg2(Right(str, 1) & Left(str, (t - 2)), i - 1, t)
End Sub

JX_shangrila

表格数据按下图