怎样用vba实现写出全部搭配组合

BenjaminToo

如题，这些

BenjaminToo

比如，function function function function
           function Service  function   function
           …
这样，谢谢

zhenghui13

请查看是否能达到效果，我没办法上传附件。
你需要将原始数据填写在Sheet1的第1 列，输出结果在Sheet2中
For j = 1 To nElement
    brr(j) = Sheet1.Cells(j, 1).Value           'Data Readin
Next j

1. 
   
2. 'http://club.excelhome.net/thread-1472622-1-1.html
   
3. 
   
4. 'Public Parameter
   
5. Public Out(), mOut, nOut
   
6. Public Nums%, nElement%
   
7. Public Org()
   
8. Public arr
   
9. 
   
10. Sub Main_Combination()
    
11. Dim i&, j&
    
12. Nums = 4
    
13. nElement = 8
    
14. ReDim Org(1 To Nums)
    
15. ReDim Out(1 To nElement ^ Nums, 1 To Nums)    'Output Array
    
16. ReDim arr(1 To Nums)             'Tmp Array
    
17. ReDim brr(1 To nElement)         'Array of Element
    
18. For j = 1 To nElement
    
19.     brr(j) = Sheet1.Cells(j, 1).Value           'Data Readin
    
20. Next j
    
21. For i = 1 To Nums
    
22.     Org(i) = brr     '2 Dimension Array
    
23. Next i
    
24. Combine_Recursion_Front Nums, 1, nElement
    
25. Sheet2.Cells(1, 1).Resize(UBound(Out), UBound(Out, 2)) = Out
    
26. End Sub
    
27. 
    
28. '
    
29. Sub Combine_Recursion_Front(m, n, k)
    
30. Dim i, j                     'Variance
    
31. For i = n To k               'Loop Element
    
32.     arr(m) = Org(m)(i)       'Data into Temp Array
    
33.     If m > 1 Then            'Recrusion, process next
    
34.         Combine_Recursion_Front m - 1, n, k
    
35.     Else
    
36.         Arr_In_Out arr       'Output Array
    
37.     End If
    
38. Next i
    
39. End Sub
    
40. 
    
41. 'Data into Output Array
    
42. Sub Arr_In_Out(arr)
    
43. nOut = nOut + 1
    
44. For mOut = 1 To UBound(arr)
    
45.     Out(nOut, mOut) = arr(mOut)
    
46. Next
    
47. End Sub

复制代码

BenjaminToo

zhenghui13 发表于 2019-4-19 14:58
请查看是否能达到效果，我没办法上传附件。
你需要将原始数据填写在Sheet1的第1 列，输出结果在Sheet2中
...

Nice, 达到效果，谢谢你~