下面是固定提取数的主要代码vba(即在C(m,n)中n是固定的) 需排列数据在arr数组中 n是组合后的结果数量 n = WorksheetFunction.Combin(h, 6) ReDim arr1(1 To n, 1 To 6) For a = 1 To h For b = 1 a To h For c = 1 b To h For d = 1 c To h For e = 1 d To h For f = 1 e To h i = i 1 arr1(i, 1) = arr(a, 1) arr1(i, 2) = arr(b, 1) arr1(i, 3) = arr(c, 1) arr1(i, 4) = arr(d, 1) arr1(i, 5) = arr(e, 1) arr1(i, 6) = arr(f, 1) Next f Next e Next d Next c Next b Next a 建议你直接运行代码理解吧(如从1~8取6,只有28个结果,相信你看到结果就能理解的),不知怎么解释 如果你需要m,n两数都是不固定的,以下是我以前写的,现在也不知道怎么解释了,还是那一句,你得自己运行并理解 Sub Cmn固定数组法() '固定数组法 Dim rng Dim r As Range Dim tc As Long, i_z As Long Dim MaxR As Long, max As Double, n1 As Long, n2 As Long, n3 As Long Dim i As Long, j As Long, c As Long Dim all(), arr(), arr_z() Dim str As String, str_arr As String On Error Resume Next Set rng = Application.InputBox("请选择一个单元格区域", "明天beyond", Type:=8) If rng Is Nothing Then Exit Sub On Error GoTo 0 '将rng中非空的值传入数组arr For Each r In rng If r <> "" Then ReDim Preserve arr(i) arr(i) = r.Value i = i 1 End If Next 'Application.ScreenUpdating = False i_z = i str = "选取元素总个数:" & i & vbLf Set rng = Nothing tc = Application.InputBox("请输入组合个数", "明天beyond", Type:=1) If tc = 0 Or tc > i Then Exit Sub '判断提取数是否大于待提取数,如果为真则退出 'MaxR 是表示在第一次取值(提取第二位)时能到达的最大数。 t = Timer MaxR = i - tc 1 max = WorksheetFunction.Combin(i, tc) ReDim all(1 To max, 1 To tc * 2) ReDim arr_z(1 To max) For i = 1 To MaxR all(i, 1) = arr(i - 1) all(i, 2) = i 1 Next ji = MaxR For c = 1 To tc - 1 n1 = 1 n2 = c * 2 1 For i = 1 To ji For j = all(i, c * 2) To MaxR c all(n1, n2) = all(i, n2 - 2) & "-" & arr(j - 1) all(n1, n2 1) = j 1 n1 = n1 1 Next Next ji = n1 - 1 Next n3 = tc * 2 - 1 For i = 1 To max arr_z(i) = all(i, n3) Next '___________________ 'Application.ScreenUpdating = True t = Timer - t t2 = Timer On Error Resume Next Set rng = Application.InputBox("结果保存到……?", "明天beyond", Type:=8) If rng Is Nothing Then Exit Sub On Error GoTo 0 tc = WorksheetFunction.Combin(i_z, tc) str = str & "结果有" & tc & "个" If tc > Rows.Count Then MsgBox "无法保存全部结果,只能保存前" & Rows.Count & "条" rng.Range("a1").Resize(tc, 1) = WorksheetFunction.Transpose(arr_z) MsgBox "已完成操作!" & vbLf & vbLf & str & "时间" & Timer - t2 t, vbInformation, "明天beyond" End Sub
温馨提示:答案为网友推荐,仅供参考