所有可能的10个数字的组合,在Excel中重复

如何在Excel中生成长度为5的数字{0,1,2,3,4,5,6,7,8,9}的所有可能组合。 我知道有10 ^ 5个重复的可能组合。 谢谢

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 

这可能会运行得更快一些:

 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 

比原来快得多。 数组方法可能不是很多。 至less这是一种不同的技巧