“没有最好，只有更好”——论坛“纠客”

Zamyi

“没有最好，只有更好”是好多企业的文化理念；而在情感上，如上《非诚勿扰》，往往更易牵手成功；对于程序，偶也是这么认为。彭版的排列组
合（http://club.excelhome.net/viewth ... 1%D0%2B%D7%EE%D3%C5）算法非常巧妙，但是冠以“最优”，让许
多“纠客”内心蠢蠢欲动，想挑出毛病来。下面就让偶做一下论坛“纠客”吧。
    1、显式地声明数据类型，尽量不要使用Variant类型，省去类型的转换，可以提高不少效力，也节省内存；
    2、一维数组比二维形式速度更快；通过这两步的优化，就算法（不考虑写入文件）约可提高一倍的效率，见Peng2。
    3、对于连接字符串，用“&”效率并不高，特别M值比较大时更是降低效率的凶杀，以N=30、M=6和N=30、M=24为例，取得同样的组合数，后者用时是
前者的4倍多，可以考虑用MID句替之；
    4、用“Open "d:\peng.txt" For Output As #1”逐个写入虽可以防止内存溢出，但效率也降低，可以考虑把数据先存放在数组（内存允许内的大小
），再分次写入文件。这一步待完善。

1. Option Base 1
   
2. 'Dim c() As String
   
3. Dim a() As String
   
4. Dim b() As Integer
   
5. Dim n%, m%, Mn&, nL As Byte, S$, Rng As Range
   
6. Public Sub ZhuHe()
   
7. Dim cc, x%, Sl$
   
8. S = ""
   
9. t = Timer
   
10. n = Cells(65536, 1).End(3).Row
    
11. m = [b1]
    
12. ReDim a(n)
    
13. ReDim b(m)
    
14. r = Range("a1:a" & n)
    
15. For Each cc In r
    
16.   If Len(cc) > nL Then nL = Len(cc)
    
17. Next
    
18. Sl = String(nL, "0")
    
19. For i = 1 To n
    
20.   a(i) = Format(r(i, 1), Sl)
    
21. Next
    
22. Mn = Application.Combin(n, m)
    
23. For i = 1 To m
    
24.   b(i) = i
    
25.   S = S & " " & a(i)
    
26. Next
    
27. S = Mid(S, 2)
    
28. 'ReDim c(Mn) '数组存放
    
29. For i = 1 To Mn
    
30. '  c(i) = S '数组存放
    
31.   SetS m
    
32. Next
    
33. 
    
34. Set Rng = [f65536].End(3)(2, 1)
    
35. Rng(1, 2) = Format(Timer - t, "0.00")
    
36. Rng = Mn
    
37. Rng(1, 0) = "Zamyi"
    
38. 
    
39. 'Dim Fs As FileSystemObject, F As TextStream '写入文件
    
40. 'Set Fs = CreateObject("scripting.filesystemobject")
    
41. 'Set F = Fs.OpenTextFile("d:\Text.txt", 2, True)
    
42. 'F.Write Join(c, vbNewLine)
    
43. 'F.Close
    
44. 'Set F = Nothing
    
45. 'Set Fs = Nothing
    
46. End Sub
    
47. 
    
48. Private Sub SetS(ByVal mm%)
    
49. If b(mm) = n - m + mm Then
    
50.   If mm > 1 Then
    
51.     SetS mm - 1
    
52.     b(mm) = b(mm - 1) + 1
    
53.     Mid(S, (nL + 1) * (mm - 1) + 1, nL) = a(b(mm))
    
54.     End If
    
55.   Else
    
56.   b(mm) = b(mm) + 1
    
57.   Mid(S, (nL + 1) * (mm - 1) + 1, nL) = a(b(mm))
    
58. End If
    
59. End Sub

复制代码

flysum2008

谢谢分享，学习了！！！！！！！

doitbest

谁注重细节,谁精益求精,谁就会走得更远

白云2011

For Each cc In r
用循环代替 For Each  会不会快一点呢?

用“&”效率并不高为什么还有&
S = S & " " & a(i)

Zamyi

白云2011 发表于 2011-8-31 17:47
For Each cc In r
用循环代替 For Each  会不会快一点呢?

因为“没有最好，只有更好”。

xjm111

应该不错了,好办法!试试看,感谢Zamyi的分享！！

redsuc

折磨与精彩 !

昂首云舒掠飞鸟，欲穷半里空恨足。

我们的房太贵

你的执行结果放在哪里了

bmdsjxyw

好经验，谢谢分享

endend1980

写的真好，谢谢分享！