[已解决]这类循环方式是针对什么问题的

上清宫主 · 发表于 2012-11-10 00:35

对于特定例子，可以用1楼代码去写去理解
对于一般情况或者说通用，可能还是得用递归

爱疯 · 发表于 2012-11-10 11:23

上清宫主发表于 2012-11-10 00:35
对于特定例子，可以用1楼代码去写去理解
对于一般情况或者说通用，可能还是得用递归

没具体问题是不好说。
1楼这种方式就象一个工具，所以就想知道这种工具适合解决什么题。从具体例子中体会它的好处。
那就等下次我能举出问题，再问好了，谢谢了！

香川群子 · 发表于 2012-11-11 14:21

呵呵，我自己来回答。

1. 这样的代码作用，是最基本的，通过循环产生不重复组合的【组合代码】
结果是： =combin(m,n) 的所有组合解。

2. 用VBA代码生成组合结果，方法有很多。
a. 本例所示，是最基本的，或称最标准的数组循环方法。

优点是：
计算速度最快。（其他任何方法，都不可能比它更快！）
第2个优点是，非常直观，便于新手理解和模仿。

缺点是：
通用性不强。即，如果m,n参数需要改变，那么代码就需要重新编写……

但是，这个问题，我有自己的独门暗器解决。
即，我另做了一个生成组合代码的VBA

Sub 自动生成组合代码()
m = Val(InputBox("组合对象个数 m =", "生成组合代码", 10))
If m = 0 Then Exit Sub
n = Val(InputBox("抽取个数 n =", "生成组合代码", 3))
If n = 0 Then Exit Sub
AC = WorksheetFunction.Combin(m, n)
MsgBox "组合结果总数 = " & AC
tn = "AutoCombin_" & Format(Date, "yymmdd_") & Format(Time, "hhmm_") & "Macro"
'本组合代码名称为: 【AutoCombin_yymmdd_hhmm_Macro】，确保每次名称不同
s = s & "Sub " & tn & "()" & Chr(10) & Chr(10)
s = s & "tms = Timer" & Chr(10)
s = s & "m = " & m & " : n = " & n & Chr(10)
s = s & "ReDim jg(1 To " & AC & ", 0 To n)" & Chr(10)
T1 = "Dim i1%"
For i = 2 To n
T1 = T1 & ", i" & i & "%"
Next
s = s & T1 & Chr(10)
s = s & "For i1 = 1 To " & m - n + 1 & Chr(10)
T2 = " jg(i, 0) = i1"
T3 = " jg(i, 1) = i1"
T4 = "next i" & n
For i = 2 To n
s = s & "For i" & i & " = i" & i - 1 & " + 1 To " & m - n + i & Chr(10)
T2 = T2 & " & "","" & i" & i
T3 = T3 & " : jg(i, " & i & ") = i" & i
T4 = T4 & ", i" & n - i + 1
Next
s = s & " i = i + 1" & Chr(10)
s = s & T2 & Chr(10)
s = s & T3 & Chr(10)
s = s & T4 & Chr(10)
s = s & "[a1].CurrentRegion.Clear: [a1].Resize(i, n + 1) = jg" & Chr(10)
s = s & "[a1].Resize(, n + 1).EntireColumn.AutoFit" & Chr(10)
s = s & "Msgbox i & vbcr & Format(Timer - tms ,""0.000s"")" & Chr(10) & Chr(10)
s = s & "End Sub" & Chr(10)
'以上为止，自动生成了能够计算combin(m,n)组合的标准循环代码 s
[a1] = s '输出代码到A1单元格中（代码行之间有换行符）
' 如果只需要添加模块到当前工作簿，但不需要自动执行新生成的代码，则：
Set t = ActiveWorkbook.VBProject.VBComponents.Add(1) '在当前工作簿文件中自动添加模块
t.CodeModule.AddFromString s '在此新添加的模块中写入此代码
Exit Sub
'如果要立即自动执行此组合代码，那么：
Set t = ThisWorkbook.VBProject.VBComponents.Add(1) '在本代码所属工作簿文件中自动添加模块，
t.CodeModule.AddFromString s '在此新添加的模块中写入此代码
Application.Run tn '自动执行此代码
ThisWorkbook.VBProject.VBComponents.Remove t '执行完之后立即删掉此代码模块→不需要时注释掉
End Sub

复制代码

执行上述代码，就能自动生成标准的，生成combin(m,n)解的代码。

例如，执行代码，输入m=5，n=3参数后，自动在当前工作薄内生成一个模块，里面有代码：

Sub AutoCombin_121111_1419_Macro()

tms = Timer
m = 5: n = 3
ReDim jg(1 To 10, 0 To n)
Dim i1%, i2%, i3%
For i1 = 1 To 3
For i2 = i1 + 1 To 4
For i3 = i2 + 1 To 5
i = i + 1
jg(i, 0) = i1 & "," & i2 & "," & i3
jg(i, 1) = i1: jg(i, 2) = i2: jg(i, 3) = i3
Next i3, i2, i1
[a1].CurrentRegion.Clear: [a1].Resize(i, n + 1) = jg
[a1].Resize(, n + 1).EntireColumn.AutoFit
MsgBox i & vbCr & Format(Timer - tms, "0.000s")

End Sub

香川群子 · 发表于 2012-11-11 14:23

本帖最后由香川群子于 2012-11-11 14:24 编辑

方法2，递归方法生成组合代码：

Dim sj, jg(), m%, n%, k
Sub 组合递归()
tms = Timer
m = [a1].End(4).Row: sj = [a1].Resize(m): n = [b1]
AC = WorksheetFunction.Combin(m, n): ReDim jg(AC, n): k = 0
Call dgZH("", 0, 0): MsgBox Timer - tms
[b3] = AC: [d1].CurrentRegion = "": If AC < 65536 Then [d1].Resize(AC, n + 1) = jg
End Sub
Sub dgZH(s$, i%, t%)
Dim j%
If t = n Then
p = Split(s, ";")
For j = 1 To n
jg(k, j) = sj(p(j), 1)
jg(k, 0) = jg(k, 0) & ";" & sj(p(j), 1)
Next
jg(k, 0) = Mid(jg(k, 0), 2):
k = k + 1: Exit Sub
End If
For j = i + 1 To m
Call dgZH(s & ";" & j, j, t + 1)
Next j
End Sub

复制代码

优点，通用性强，但计算速度稍慢。（递归的缺点，你懂的。）

香川群子 · 发表于 2012-11-11 15:16

最后，是数组循环方式的通用代码。

Sub GetCombin()
tms = Timer
Dim i&, j%, k&, l%, m%, n%, s&
m = [a1].End(4).Row
n = [b1]
arr = [a1].Resize(m)
s = Application.Combin(m, n)
ReDim crr(1 To s, 1 To 1)
ReDim a%(1 To n)
a(1) = 1
If n > 1 Then t = arr(1, 1) Else t = ""
For i = 2 To n - 1
a(i) = i
t = t & ";" & arr(i, 1)
Next
a(n) = n
For i = 1 To s 'Application.Combin(m, n)
'k = k + 1: crr(k, 1) = t & ";" & arr(a(n), 1)
crr(i, 1) = t & ";" & arr(a(n), 1)
a(n) = a(n) + 1
If a(n) > m Then
If a(1) > m - n Then GoTo Ext
For j = 2 To n
If a(j) >= m - n + j Then l = j - 1: Exit For
Next j
a(l) = a(l) + 1
For j = l + 1 To n
a(j) = a(j - 1) + 1
Next j
t = arr(a(1), 1)
For j = 2 To n - 1
t = t & ";" & arr(a(j), 1)
Next j
End If
Next i
Ext:
MsgBox Format(Timer - tms, "0.000s")
tms = Timer
[d:d] = ""
[d1].Resize(s) = crr
[d1].EntireColumn.AutoFit
MsgBox Format(Timer - tms, "0.000s")
End Sub

复制代码

比递归速度快，但代码相对复杂很多。

香川群子 · 发表于 2012-11-11 15:18

还有，就是利用现成的第3方脚本程序软件如rubby等方法……但是速度超级慢。

所以，如果自己有能力，还是不要用这些第3方程序为好。

爱疯 · 发表于 2012-11-11 15:31

香川群子发表于 2012-11-11 14:23
方法2，递归方法生成组合代码：优点，通用性强，但计算速度稍慢。（递归的缺点，你懂的。）

谢谢群子老师！

群子老师的回复，就像饱和式攻击，特详细、充分，且非常容易查看。
对于排列组合，如何入门，如何学才更有效率?大家都很想知道并学会，但还是得作些准备。群子老师这是这方面的专家，特别希望您能给小结一篇扫盲普及贴，以新手角度，给出指导和建议。
这样，再读群子老师及各位高手们的回复时，就能更好的理解了。不然，那么多回复没理解的话，实在太可惜啦！

香川群子 · 发表于 2012-11-11 18:36

爱疯发表于 2012-11-11 15:31
谢谢群子老师！

群子老师的回复，就像饱和式攻击，特详细、充分，且非常容易查看。

你都已经是超级版主了，为啥还要问这些基础的、简单的问题？

我对VBA的排列/组合，自己做了深入的研究，所以知识比较全面。

但是对于一般爱好者来说，能够用for……next循环写成可执行的代码就足够了。

没必要研究那么细的。

因为里面主要是各种利用VBA数组的算法问题了。一般人即使看了代码，也不容易弄明白的。

香川群子 · 发表于 2012-11-11 18:43

上清宫主发表于 2012-11-10 00:05
对，就是这个意思
从m个元素中取n个（n

呵呵。VBA数组for……next循环的代码例子，我在这个帖子里提供了。

你有兴趣研究一下吧。

简单思路是，对于m个元素中取n个的组合解：
1。建立储存1-n状态的数组
2。从末位(n)位开始递增升位，并记录该组合
3。当末位(n)状态递增到=m时，检查并找到x位置使得在x位进行递增而不导致错误……（详细规则略）
4。加入终止循环的判断

呵呵。

爱疯 · 发表于 2012-11-11 21:55

香川群子发表于 2012-11-11 18:36
你都已经是超级版主了，为啥还要问这些基础的、简单的问题？

我对VBA的排列/组合，自己做了深入的研究 ...

谢谢群子老师！

下去再慢慢理解了{:25:}

		自动登录	找回密码
密码			注册