1、界面:
2、代码截图,两个截图,中间有少许重复:
3、我运行的结果有55980个不同组合,第一张截图只是很少一部分。为了便于复制,下面是是完整代码:
Dim arr
Dim arr1(100000, 2)
arr = Range("a2:a" & [a10000].End(3).Row)
js = Cells(2, 2)
sl = 0
For i = 2 To js
If i = 2 Then
For k = 1 To UBound(arr)
For j = 1 To UBound(arr)
sl = sl + 1
arr1(sl, 1) = arr(k, 1) + arr(j, 1)
arr1(sl, 2) = arr(k, 1) & "+" & arr(j, 1)
Next j
Next k
End If
If i = 3 Then
For k = 1 To UBound(arr)
For j = 1 To UBound(arr)
For m = 1 To UBound(arr)
sl = sl + 1
arr1(sl, 1) = arr(k, 1) + arr(j, 1) + arr(m, 1)
arr1(sl, 2) = arr(k, 1) & "+" & arr(j, 1) & "+" & arr(m, 1)
Next m
Next j
Next k
End If
If i = 4 Then
For k = 1 To UBound(arr)
For j = 1 To UBound(arr)
For m = 1 To UBound(arr)
For l = 1 To UBound(arr)
sl = sl + 1
arr1(sl, 1) = arr(k, 1) + arr(j, 1) + arr(m, 1) + arr(l, 1)
arr1(sl, 2) = arr(k, 1) & "+" & arr(j, 1) & "+" & arr(m, 1) & "+" & arr(l, 1)
Next l
Next m
Next j
Next k
End If
If i = 5 Then
For k = 1 To UBound(arr)
For j = 1 To UBound(arr)
For m = 1 To UBound(arr)
For l = 1 To UBound(arr)
For n = 1 To UBound(arr)
sl = sl + 1
arr1(sl, 1) = arr(k, 1) + arr(j, 1) + arr(m, 1) + arr(l, 1) + arr(n, 1)
arr1(sl, 2) = arr(k, 1) & "+" & arr(j, 1) & "+" & arr(m, 1) & "+" & arr(l, 1) & "+" & arr(n, 1)
Next n
Next l
Next m
Next j
Next k
End If
If i = 6 Then
For k = 1 To UBound(arr)
For j = 1 To UBound(arr)
For m = 1 To UBound(arr)
For l = 1 To UBound(arr)
For n = 1 To UBound(arr)
For h = 1 To UBound(arr)
sl = sl + 1
arr1(sl, 1) = arr(k, 1) + arr(j, 1) + arr(m, 1) + arr(l, 1) + arr(n, 1) + arr(h, 1)
arr1(sl, 2) = arr(k, 1) & "+" & arr(j, 1) & "+" & arr(m, 1) & "+" & arr(l, 1) & "+" & arr(n, 1) & "+" & arr(h, 1)
Next h
Next n
Next l
Next m
Next j
Next k
End If
Next i
For i = 1 To sl
Cells(i + 1, 4) = arr1(i, 1)
Cells(i + 1, 5) = arr1(i, 2)
Next i