查看: 8523|回复: 5
我有已知的6个数字，如何生成6位的所有排列组合？
阅读权限20
在线时间 小时
我有已知的6个数字（0,0,3,7,8,9），如何用EXCEL生成6位的所有排列组合？
希望版主 早日看到提供解答
[ 本帖最后由 zhongshen197 于
12:54 编辑 ]
阅读权限20
在线时间 小时
顶一下，请版主或是老手帮助解决 一下，谢谢。
阅读权限20
在线时间 小时
在坛子里找到这样个程序，修改后运行成功，有720个结果
Sub PermutationsFromRange()
Dim DestRange As Object
Dim PermString As Variant
Dim NewPerm As String
Dim SepChar As String
Dim NumOfElements As Integer
Dim NumOfPerm As Double
Dim Factorial(1 To 6)
Dim Counter1 As Long
Dim Counter2 As Long
Dim Rotate As Integer
& & 'Max 13 elements in PermString
& & PermString = Range(&A1:A6&)
& & SepChar = &,&
& & NumOfElements = UBound(PermString)
& & NumOfPerm = Application.Fact(NumOfElements)
& & For Counter1 = 1 To NumOfElements
& && &&&Factorial(Counter1) = Application.Fact(NumOfElements - Counter1)
& & Next Counter1
& & Worksheets.Add
& & Set DestRange = Range(&a1&)
& & For Counter1 = 1 To NumOfElements
& && &&&NewPerm = NewPerm & PermString(Counter1, 1) & SepChar
& & Next Counter1
& & DestRange.Value = Left(NewPerm, Len(NewPerm) - Len(SepChar))
& & For Counter1 = 2 To NumOfPerm
& && &&&NewPerm = &&
& && &&&If Counter1 / 2 = Int(Counter1 / 2) Then
& && && && &Rotate = NumOfElements - 1
& && &&&Else
& && && && &For Counter2 = 1 To NumOfElements - 2
& && && && && & If Counter1 Mod Factorial(Counter2) = 1 Then
& && && && && && &&&Rotate = Counter2
& && && && && && &&&Exit For
& && && && && & End If
& && && && &Next Counter2
& && &&&End If
& && &&&For Counter2 = 1 To Int((NumOfElements - Rotate + 1) / 2)
& && && && &Dummy = PermString(Rotate + Counter2 - 1, 1)
& && && && &PermString(Rotate + Counter2 - 1, 1) = PermString(NumOfElements - Counter2 + 1, 1)
& && && && &PermString(NumOfElements - Counter2 + 1, 1) = Dummy
& && &&&Next Counter2
& && &&&For Counter2 = 1 To NumOfElements
& && && && &NewPerm = NewPerm & PermString(Counter2, 1) & SepChar
& && &&&Next Counter2
& && &&&DestRange.Offset(Counter1 - 1) = Left(NewPerm, Len(NewPerm) - Len(SepChar))
& & Next Counter1
Set DestRange = Nothing
阅读权限95
在线时间 小时
& & & & & & & &
两种方法，供你选择
硬循环法远比ADO法快
& &&&'撰写:老朽
& && &'网址:
& && &'日期: 下午 01:22:55
Sub ADO法()
& & Dim My_Cn
& & Dim My_Sql As String
& & With Sheets(&Ado法&)
& && &&&.Cells.Clear
& && &&&Set My_Cn = CreateObject(&adodb.connection&)
& && &&&My_Sql = &SELECT * FROM [Sheet1$A1:A100] as A1,[Sheet1$A1:A100] as A2,[Sheet1$A1:A100] as A3,[Sheet1$A1:A100] as A4,[Sheet1$A1:A100] as A5,[Sheet1$A1:A100] as A6&
& && &&&My_Cn.Open &provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;HDR=yes';data source=& & ThisWorkbook.FullName
& && &&&.Range(&A1&).CopyFromRecordset My_Cn.Execute(My_Sql)
& && &&&My_Cn.Close
& && &&&Set My_Cn = Nothing
& & End With
& && &'撰写:老朽
& && &'网址:
& && &'日期: 下午 01:22:56
Sub 硬循环法()
& & Arr = Sheet1.[A2:A7]
& & Dim Brr(1 To 46656, 1 To 6)
& & For i = 1 To 6
& && &&&For j = 1 To 6
& && && && &For k = 1 To 6
& && && && && & For l = 1 To 6
& && && && && && &&&For m = 1 To 6
& && && && && && && && &For n = 1 To 6
& && && && && && && && && & Brr(o, 1) = Arr(i, 1)
& && && && && && && && && & Brr(o, 2) = Arr(j, 1)
& && && && && && && && && & Brr(o, 3) = Arr(k, 1)
& && && && && && && && && & Brr(o, 4) = Arr(l, 1)
& && && && && && && && && & Brr(o, 5) = Arr(m, 1)
& && && && && && && && && & Brr(o, 6) = Arr(n, 1)
& && && && && && && && && & o = o + 1
& && && && && && && && &Next
& && && && && && &&&Next
& && && && && & Next
& && && && &Next
& && &&&Next
& & Sheet3.[A1:F46656] = Brr
阅读权限95
在线时间 小时
(11.5 KB, 下载次数: 250)
13:26 上传
点击文件名下载附件
这是附件，可以对照使用，数据在SHEET1中
阅读权限50
在线时间 小时
有46656个结果
Sub 排列组合()
Dim a%, b%, c%, d%, e%, f%, n&
ary = Array(0, 0, 3, 7, 8, 9)
For a = 0 To 5
For b = 0 To 5
For c = 0 To 5
For d = 0 To 5
For e = 0 To 5
For f = 0 To 5
Cells(n, 1) = ary(a) & ary(b) & ary(c) & ary(d) & ary(e) & ary(f)
Next: Next: Next: Next: Next: Next
最新热点 /1
ExcelHome每周都有线上直播公开课，
国内一流讲师真身分享，高手贴身答疑，
赶不上直播还能看录像，
关键居然是免费的！
厚木哥们都已经这么努力了，
你还好意思说学不好Office。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师}