ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > E问E答 > Excel VBA > 如何求出n个数据的全排列实体?

如何求出n个数据的全排列实体?

作者:绿色风 分类: 时间:2022-08-17 浏览:85
楼主
xyh9999
Q:如何求出n个数据的全排列实体?
A:利用VBA代码如下
Lqc全排列实例.rar


  1. Public 存放输出 As Collection
  2. Sub 测试1() '3个字符的全排列
  3.   Lqc_全排列 3, Sheet1.Name
  4. End Sub
  5. Sub 测试2() '4个字符的全排列
  6.   Lqc_全排列 4, Sheet1.Name
  7. End Sub
  8. Sub 测试3() '5个字符的全排列
  9.   Lqc_全排列 5, Sheet1.Name
  10. End Sub
  11. Sub Lqc_全排列(n As Integer, cSheet As String) '列出n个字符的全排列,结果放置于cSheet表中
  12. Sheets(cSheet).Cells.ClearContents
  13. Dim a() As String
  14. Dim result() As String
  15. Dim kk As Long
  16. Dim i As Long
  17. If n > 26 Then
  18.     MsgBox "字符数太多,请不要超过26!"
  19.     Exit Sub
  20. End If
  21. Set 存放输出 = New Collection
  22. ReDim a(1 To n)
  23. ReDim result(1 To n)
  24. For i = 1 To n
  25.     a(i) = Chr(i + 64)
  26. Next i
  27. Lqc_全排列核心 result, a
  28. kk = 存放输出.Count
  29. For i = 1 To kk
  30.    Sheets(cSheet).Cells(IIf(i Mod 60000 = 0, 60000, i Mod 60000), (i - 0.6) \ 60000 + 1) = 存放输出(i) '如果不是在Excel,可以输出到需要的地方
  31. Next
  32. End Sub
  33. Sub Lqc_全排列核心(ByRef 结果() As String, ByRef 需排列字符() As String)  '结果:排列结果 需排列字符:尚需进行排列的字符
  34. Dim i As Long, j As Long
  35. Dim 剩下字符() As String
  36. Dim temp As String
  37. j = UBound(需排列字符) - LBound(需排列字符) + 1
  38. If j > 1 Then
  39.     ReDim 剩下字符(1 To j - 1)
  40.     For i = 1 To j - 1
  41.         剩下字符(i) = 需排列字符(i + 1)
  42.     Next
  43.     j = UBound(结果)
  44.     For i = 1 To j
  45.         If 结果(i) = "" Then
  46.             结果(i) = 需排列字符(1)
  47.             Lqc_全排列核心 结果, 剩下字符
  48.             结果(i) = ""
  49.         End If
  50.     Next
  51.    
  52. Else
  53.     For j = 1 To UBound(结果)
  54.         If 结果(j) = "" Then
  55.             结果(j) = 需排列字符(1)
  56.             temp = ""
  57.             For i = 1 To UBound(结果)
  58.                 temp = temp & 结果(i)
  59.             Next
  60.             存放输出.Add temp
  61.             结果(j) = ""
  62.             Exit Sub
  63.         End If
  64.     Next
  65. End If
  66. End Sub
2楼
学习vba
很好,,,谢谢。

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap