Excel中有10個重複的所有可能的組合

Question

如何在Excel中生成長度爲5的數字{0,1,2,3,4,5,6,7,8,9}的所有可能組合。我知道有10^5個重複的可能組合。 謝謝

Answer 1

elene的代碼略有修改。

Sub AllCombinations() 
    Dim nums(): nums = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9) 
    Dim arValues(99999, 4) 
    Dim n1 As Integer, n2 As Integer, n3 As Integer, n4 As Integer, n5 As Integer, x As Long 

    For n1 = 0 To UBound(nums) 
     For n2 = 0 To UBound(nums) 
      For n3 = 0 To UBound(nums) 
       For n4 = 0 To UBound(nums) 
        For n5 = 0 To UBound(nums) 
         arValues(x, 0) = nums(n1) 
         arValues(x, 1) = nums(n2) 
         arValues(x, 2) = nums(n3) 
         arValues(x, 3) = nums(n4) 
         arValues(x, 4) = nums(n5) 
         x = x + 1 
        Next 
       Next 
      Next 
     Next 
    Next 

    Range("A1").Resize(100000, 5).Value2 = arValues 

End Sub 

Answer 2

這可能運行快一點：

Sub combinations() 
Dim wb As Workbook, i As Integer, strFileName As String 

'Create Temp Workbook for data source 
Set wb = Workbooks.Add 
With wb.ActiveSheet 
    .Range("A1").Value = "Integer" 
    For i = 0 To 9 
     .Range("A" & i + 2).Value = i 
    Next i 
End With 
strFileName = "C:\Temp\Temp.xlsx" 
wb.SaveAs strFileName 
wb.Close False 

'Create List using Temp Workbook as source(s) 
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array("ODBC;DBQ=" & strFileName & ";DefaultDir=C:\temp;Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DriverId=1046;FIL=exce"), Array("l 12.0;MaxBufferSize=2048;MaxScanRows=8;PageTimeout=5;ReadOnly=1;SafeTransactions=0;Threads=3;UID=admin;UserCommitSync=Yes;")), Destination:=Range("$A$1")).QueryTable 
    .CommandText = Array(_ 
    "SELECT `Sheet1$`.Integer, `Sheet1$_1`.Integer, `Sheet1$_2`.Integer, `Sheet1$_3`.Integer, `Sheet1$_4`.Integer" & Chr(13) & "" & Chr(10) & "FROM `" & strFileName & "`.`Sheet1$` `Sheet1$`, `" & strFileName & "`.`Sheet1$` `Sheet1$_1`, `", strFileName & "`.`Sheet1$` `Sheet1$_2`, `" & strFileName & "`.`Sheet1$` `Sheet1$_3`, `" & strFileName & "`.`Sheet1$` `Sheet1$_4`") 
    .RowNumbers = False 
    .FillAdjacentFormulas = False 
    .PreserveFormatting = True 
    .RefreshOnFileOpen = False 
    .BackgroundQuery = True 
    .RefreshStyle = xlInsertDeleteCells 
    .SavePassword = False 
    .SaveData = False 
    .AdjustColumnWidth = True 
    .RefreshPeriod = 0 
    .PreserveColumnInfo = True 
    .ListObject.DisplayName = "Table_Query_from_Temp" 
    .Refresh BackgroundQuery:=False 
End With 

'Convert back to range 
ActiveSheet.ListObjects("Table_Query_from_Temp").Unlist 

'Delete top row 
Rows("1:1").Delete 

'Delete Temp file 
Kill strFileName 
End Sub 

那麼比原來更快。對於數組方法可能不是很多。它至少一種不同的技術...