[已解决]关于任意字符串组合问题

qcw811206

辛苦了
题目如题
例如 abc
返回  a，b，c，d，ab，ac，bc，abc
例如 ab
返回 a，b，ab

据说递归可以做
但是我不会（遇到递归就蒙），
希望大家提供思路
来一起探讨

最佳答案

月排行榜 / 总排行榜

香川群子

2014-11-27 22:21

这样子才是全部组合：

递归的代码确实很简单。

1. Dim jg(), k&, n&, s$
   
2. Sub 组合() 'by kagawa 2014/11/27
   
3.     s = [a1]: n = Len(s): ReDim jg(2 ^ n)
   
4.     k = 0: Call dgQZH("", 0)
   
5.     [a3].CurrentRegion = "": [a2].Resize(k) = WorksheetFunction.Transpose(jg)
   
6. End Sub
   
7. Sub dgQZH(r$, i&)
   
8.     Dim j&
   
9.     jg(k) = r: k = k + 1
   
10.     For j = i + 1 To n
    
11.         Call dgQZH(r & Mid(s, j, 1), j)
    
12.     Next
    
13. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Dim w, n%, arr(1 To 60000, 1 To 1), s&
   
2. Sub Macro1()
   
3. w = Array("a", "b", "c")
   
4. n = UBound(w) + 2
   
5. aa "", 0
   
6. Range("a1").Resize(s) = arr
   
7. End Sub
   
8. Sub aa(p$$, t%)
   
9. If t < n And t > 0 Then
   
10.     s = s + 1
    
11.    arr(s, 1) = p
    
12. End If
    
13. For i = 0 To UBound(w)
    
14.     If InStr(p, w(i)) = 0 Then aa p & w(i), t + 1
    
15. Next
    
16. End Sub

复制代码

香川群子

dsmch 发表于 2014-11-27 16:24

呵呵，你这个是各种排列都出来的，不是组合了。

香川群子

这样子才是全部组合：

递归的代码确实很简单。

1. Dim jg(), k&, n&, s$
   
2. Sub 组合() 'by kagawa 2014/11/27
   
3.     s = [a1]: n = Len(s): ReDim jg(2 ^ n)
   
4.     k = 0: Call dgQZH("", 0)
   
5.     [a3].CurrentRegion = "": [a2].Resize(k) = WorksheetFunction.Transpose(jg)
   
6. End Sub
   
7. Sub dgQZH(r$, i&)
   
8.     Dim j&
   
9.     jg(k) = r: k = k + 1
   
10.     For j = i + 1 To n
    
11.         Call dgQZH(r & Mid(s, j, 1), j)
    
12.     Next
    
13. End Sub

复制代码

香川群子

dsmch 发表于 2014-11-27 16:24

你代码的运行结果：
a,ab,abc,ac,acb,b,ba,bac,bc,bca,c,ca,cab,cb,cba

一共是15个结果。比楼主例子多多了。

上清宫主

都比楼主少了，少了d

张雄友

上清宫主 发表于 2014-11-27 22:27
都比楼主少了，少了d

你也太牛了，专门发现这种东西。

上清宫主

张雄友 发表于 2014-11-27 22:31
你也太牛了，专门发现这种东西。

你的序号整出来了？不去研究你的代码，追到我说啥子？真是的

香川群子

上清宫主 发表于 2014-11-27 22:27
都比楼主少了，少了d

早发现了……但我们选择自动做容错处理。呵呵。

香川群子

因为是依据递归算法，所以4楼代码得到的组合结果，并非按字典顺序排列。
如：a; ab; abc; ac; b; bc; c

下面代码在递归过程中加入了数组记录状态的部分，以便按字典顺序返回结果。
如：a; b; c; ab; ac; bc; abc

这个就比较高级一点了，呵呵。

1. Dim jg(), k&, n&, s$
   
2. Sub QZH2()
   
3.     s = [a1]: n = Len(s): ReDim jg(2 ^ n, 1)
   
4.     k = 0: Call dgQZH2(1, 0)
   
5.     [a3].CurrentRegion = "": [a2].Resize(k + 1) = jg
   
6. End Sub
   
7. Sub dgQZH2(i&, j&) 'by kagawa 2014/11/28 字典順
   
8.     Dim l&
   
9.     For j = j To k
   
10.         For l = jg(j, 1) + 1 To n
    
11.             k = k + 1: jg(k, 0) = jg(j, 0) & Mid(s, l, 1): jg(k, 1) = l
    
12.         Next
    
13.     Next
    
14.     If i < n Then Call dgQZH2(i + 1, j)
    
15. End Sub
    

复制代码