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

时间:2016-09-07 10:31:37

标签: excel excel-vba macros permutation vba

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

2 个答案:

答案 0 :(得分:2)

稍微修改了elene的代码。

enter image description here

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

答案 1 :(得分:0)

这可能会更快一点:

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

比原来快得多。阵列方法可能不是很多。这至少是一种不同的技术......