楼主
willin2000 |
Q：如何自动生成所有排列组合？
A：下列代码列出在1-7中取5个数的所有组合：- Sub ListComb5of7()
- Dim II%, I%, J%, K%, L%, M%
- Dim Srt1$, Srt2$, Srt3$, Srt4$, Srt5$
- Dim TStr1$, TStr2$, TStr3$, TStr4$
- Const FullStr = "1234567"
- II = 0
- For I = 1 To 7
- Srt1 = Mid(FullStr, I, 1)
- TStr1 = Replace(FullStr, Srt1, "")
- For J = 1 To 6
- Srt2 = Mid(TStr1, J, 1)
- TStr2 = Replace(TStr1, Srt2, "")
- For K = 1 To 5
- Srt3 = Mid(TStr2, K, 1)
- TStr3 = Replace(TStr2, Srt3, "")
- For L = 1 To 4
- Srt4 = Mid(TStr3, L, 1)
- TStr4 = Replace(TStr3, Srt4, "")
- For M = 1 To 3
- Srt5 = Mid(TStr3, M, 1)
- II = II + 1
- Cells(II, 1) = Srt1 & Srt2 & Srt3 & Srt4 & Srt5
- Next
- Next
- Next
- Next
- Next
- End Sub
|
3楼
gvntw |
谢谢 Willin2000 兄的分享！
代码优化如下，速度将提高10倍，数量大时更显优势。
- Sub ListComb5of7()
- Dim II%, I%, J%, K%, L%, M%
- Dim Srt1$, Srt2$, Srt3$, Srt4$, Srt5$
- Dim TStr1$, TStr2$, TStr3$, TStr4$
- Dim t, arr()
- Const FullStr = "1234567"
- t = Timer
- II = 0
- For I = 1 To 7
- Srt1 = Mid(FullStr, I, 1)
- TStr1 = Replace(FullStr, Srt1, "")
- For J = 1 To 6
- Srt2 = Mid(TStr1, J, 1)
- TStr2 = Replace(TStr1, Srt2, "")
- For K = 1 To 5
- Srt3 = Mid(TStr2, K, 1)
- TStr3 = Replace(TStr2, Srt3, "")
- For L = 1 To 4
- Srt4 = Mid(TStr3, L, 1)
- TStr4 = Replace(TStr3, Srt4, "")
- For M = 1 To 3
- Srt5 = Mid(TStr3, M, 1)
- II = II + 1
- ReDim Preserve arr(1 To II)
- arr(II) = Srt1 & Srt2 & Srt3 & Srt4 & Srt5
- Next
- Next
- Next
- Next
- Next
- Range("A1:A" & II) = Application.Transpose(arr)
- MsgBox Timer - t
- End Sub
|
