Question

如何用VBA实现排列组合

我想将1~33进行排列组合，顺序不限，并将所有的可能结果都列出来。请问如何用VBA实现？希望能做成现成的，复制就用，使VBA自动生成结果。多谢~~~~~

Answer 1

用excel中的VBA实现排列组合的方法：

例如：

用1-12这12个数字，从中选取6个数字做无顺序的组合数据，即一共为C(12,6)=924组数据，一组数据显示一行，如，第一组数据为“1 2 3 4 5 6”，第二组数据在第二行中显示“1 2 3 4 5 7”。

编写如下即可：

Answer 2

33个中取任意4个的宏如下：
Sub test()
Dim i, j, k, l As Byte
Application.ScreenUpdating = False
Cells(1, 1).Select
For i = 1 To 30
For j = i + 1 To 31
For k = j + 1 To 32
For l = k + 1 To 33
Selection = i
Selection.Offset(0, 1) = j
Selection.Offset(0, 2) = k
Selection.Offset(0, 3) = l
Selection.Offset(1, 0).Select
Next
Next
Next
Next
Application.ScreenUpdating = True
End Sub

33个中取任意3个的宏如下：
Sub test()
Dim i, j, k As Byte
Application.ScreenUpdating = False
Cells(1, 1).Select
For i = 1 To 31
For j = i + 1 To 32
For k = j + 1 To 33
Selection = i
Selection.Offset(0, 1) = j
Selection.Offset(0, 2) = k
Selection.Offset(1, 0).Select
Next
Next
Next
Application.ScreenUpdating = True
End Sub

33个中取任意2个的宏如下：
Sub test()
Dim i, j As Byte
Application.ScreenUpdating = False
Cells(1, 1).Select
For i = 1 To 32
For j = i + 1 To 33
Selection = i
Selection.Offset(0, 1) = j
Selection.Offset(1, 0).Select
Next
Next
Application.ScreenUpdating = True
End Sub

在2007版中，还可以实现取5个的，自己对照修改吧。取6个以上，格子不够。

Answer 3

33个中取任意4个的宏如下：
Sub test()
Dim i, j, k, l As Byte
Application.ScreenUpdating = False
Cells(1, 1).Select
For i = 1 To 30
For j = i + 1 To 31
For k = j + 1 To 32
For l = k + 1 To 33
Selection = i
Selection.Offset(0, 1) = j
Selection.Offset(0, 2) = k
Selection.Offset(0, 3) = l
Selection.Offset(1, 0).Select
Next
Next
Next
Next
Application.ScreenUpdating = True
End Sub

33个中取任意3个的宏如下：
Sub test()
Dim i, j, k As Byte
Application.ScreenUpdating = False
Cells(1, 1).Select
For i = 1 To 31
For j = i + 1 To 32
For k = j + 1 To 33
Selection = i
Selection.Offset(0, 1) = j
Selection.Offset(0, 2) = k
Selection.Offset(1, 0).Select
Next
Next
Next
Application.ScreenUpdating = True
End Sub

33个中取任意2个的宏如下：
Sub test()
Dim i, j As Byte
Application.ScreenUpdating = False
Cells(1, 1).Select
For i = 1 To 32
For j = i + 1 To 33
Selection = i
Selection.Offset(0, 1) = j
Selection.Offset(1, 0).Select
Next
Next
Application.ScreenUpdating = True
End Sub

在2007版中，还可以实现取5个的，自己对照修改吧。取6个以上，格子不够。