1、首先打开Microsoft Office Excel 2007，新建文档并保存文件名《Excel怎样从数据集选r个数据排列组合列表.xlsm》（演示文件，下面代码复制到能运行宏的工作簿都可以）如图。
2、然后按下快捷键ALT+F11打开VBA（宏）编辑界面，然后点菜单栏【插入】下拉中列表中点【模块（M）】如图。
3、然后插入了一个模块1，在代码框中复制如下代码：Option Base 1Sub 选数据排列() '2020-7-10 21:41:46 Dim myr As Range, n As Long, r As Long, i As Long, mb(), m, k As Long, mc(), mk() Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long, i5 As Long, i6 As Long, i7 As Long Dim rr As Long, cc As Long, r1 As Long, c1 As Long Set myr = Selection n = myr.Count If n <= 7 Then r = Application.InputBox(Prompt:="输入选取个数r" & "(2≤r≤" & n & "):", Type:=2) Else r = Application.InputBox(Prompt:="输入选取个数r" & "(2≤r≤7):", Type:=2) End If If n < r Then Exit Sub If r = 0 Or r = 1 Then Exit Sub ReDim mb(n) For i = 1 To n mb(i) = myr.Cells(i).Value Next i Select Case r Case Is = 2 ReDim mc(n * n) For i1 = 1 To n For i2 = 1 To n m = Array(mb(i1), mb(i2)) DoEvents If SZZF(m) = False Then k = k + 1 mc(k) = Join(m, " ") If k = 10000 Then GoTo my End If Next i2 Next i1 Case Is = 3 ReDim mc(n * n * n) For i1 = 1 To n For i2 = 1 To n For i3 = 1 To n m = Array(mb(i1), mb(i2), mb(i3)) DoEvents If SZZF(m) = False Then k = k + 1 mc(k) = Join(m, " ") If k = 10000 Then GoTo my End If Next i3 Next i2 Next i1 Case Is = 4 ReDim mc(n * n * n * n) For i1 = 1 To n For i2 = 1 To n For i3 = 1 To n For i4 = 1 To n m = Array(mb(i1), mb(i2), mb(i3), mb(i4)) DoEvents If SZZF(m) = False Then k = k + 1 mc(k) = Join(m, " ") If k = 10000 Then GoTo my End If Next i4 Next i3 Next i2 Next i1 Case Is = 5 ReDim mc(n * n * n * n * n) For i1 = 1 To n For i2 = 1 To n For i3 = 1 To n For i4 = 1 To n For i5 = 1 To n m = Array(mb(i1), mb(i2), mb(i3), mb(i4), mb(i5)) DoEvents If SZZF(m) = False Then k = k + 1 mc(k) = Join(m, " ") If k = 10000 Then GoTo my End If Next i5 Next i4 Next i3 Next i2 Next i1 Case Is = 6 ReDim mc(n * n * n * n * n * n) For i1 = 1 To n For i2 = 1 To n For i3 = 1 To n For i4 = 1 To n For i5 = 1 To n For i6 = 1 To n m = Array(mb(i1), mb(i2), mb(i3), mb(i4), mb(i5), mb(i6)) DoEvents If SZZF(m) = False Then k = k + 1 mc(k) = Join(m, " ") If k = 10000 Then GoTo my End If Next i6 Next i5 Next i4 Next i3 Next i2 Next i1 Case Is = 7 ReDim mc(n * n * n * n * n * n * n) For i1 = 1 To n For i2 = 1 To n For i3 = 1 To n For i4 = 1 To n For i5 = 1 To n For i6 = 1 To n For i7 = 1 To n m = Array(mb(i1), mb(i2), mb(i3), mb(i4), mb(i5), mb(i6), mb(i7)) DoEvents If SZZF(m) = False Then k = k + 1 mc(k) = Join(m, " ") If k = 10000 Then GoTo my End If Next i7 Next i6 Next i5 Next i4 Next i3 Next i2 Next i1 End Selectmy: rr = Rows.Count If k Mod rr = 0 Then cc = Int(k / rr) Else cc = Int(k / rr) + 1 End If ReDim mk(rr, cc) r1 = 0 c1 = 1 For i = 1 To k r1 = r1 + 1 mk(r1, c1) = mc(i) If r1 = rr Then r1 = 0 c1 = c1 + 1 End If Next i Set myr = Application.InputBox(Prompt:="输出排列数据的一个单元格！", Type:=8) If k < rr Then myr.Resize(k, cc) = mk Else Cells(1, myr.Column).Resize(rr, cc) = mk End If MsgBox "完成！"End SubFunction SZZF(m As Variant) As Boolean '2020-7-8 22:40:24 Dim i As Long, mn As Variant On Error Resume Next With CreateObject("scripting.dictionary") For i = 1 To UBound(m) .Add m(i), i Next i mn = .Keys End With If UBound(m) = UBound(mn) + 1 Then SZZF = False Else SZZF = True End IfEnd Function
4、以上操作动态过程如下：
5、回到工作表窗口，首先选原数据表，然后运行【选数据排列】宏（菜单栏中点【视图】中下列表中【宏】列表【查看宏(V)】打开宏对方框，选该宏名，执行），提示“输入选取个数r”，运行再提示"输出排列数据的一个单元格！"，选好后输出结果，运行过程如下图。如果数据大时运行时间长，到10000个组合输出结果，如果需要全部结果（如果数据量超大，一般电脑需要时间很长，甚至是无法处理完成。）把下面代码删除：If k = 10000 Then GoTo my和my:
