求助 一组数的排列组合

Question

求一组数字的，例如8个数字04 07 12 15 20 21 27 28 
求任意6个数字的所有可能的组合方式并输出

Answer 1

Option ExplicitPrivate Sub Command1_Click()
    Dim i As Integer, j As Integer
    Dim s(7) As Integer
   
        s(0) = 4
        s(1) = 7
        s(2) = 12
        s(3) = 15
        s(4) = 20
        s(5) = 21
        s(6) = 27
        s(7) = 28    For i = 0 To 7
        For j = 1 To 7
            Print s(i); s(j)
        Next j
    Next i
End Sub
只写了个定向的。凑合着看吧，也就帮这么多了哈~

Answer 2

combin(8,6)=28 手工列早列出来了

Answer 3

我这里有的，自己找一下吧：
blog.csdn.net/northwolves/category/27624.aspx

Answer 4

参照 chewinggum 之前的方法.Option ExplicitPrivate gintNum As Integer, gintGroup As Integer  '待选数据的总个数，所取数据的个数
Private ArrSrc(), gCount As Long         '用来存放源数据的数组，组合编号Private Sub Command1_Click()
    Const FETCH_NUM = 6    '取几个
    ArrSrc = Array("04", "07", "12", "15", "20", "21", "27", "28")
    
    gintNum = UBound(ArrSrc) + 1
    gintGroup = FETCH_NUM
    gCount = 1
    Call test(0, 1)
    
End SubPrivate Sub test(ByVal intStart As Integer, ByVal intLev As Integer, Optional strOutput As String)
    Dim i As Integer
    DoEvents
    If intLev > gintGroup Then Debug.Print IIf(gCount < 10, " ", "") & gCount & ":" & strOutput: gCount = gCount + 1: Exit Sub
    For i = intStart + 1 To gintNum
        Call test(i, intLev + 1, strOutput + "   " + ArrSrc(i - 1))
    Next
End Sub

Answer 5

组合和排列是二个概念,看你题意可能又是和彩票相关,应该是组合
网上有许多递归的算法,个人喜欢非递归的,自己研究的进位算法,觉得效率还可以,参考一下吧:Option Explicit'进位
Private Sub Carry(Index() As Long, M As Long, N As Long)
    Dim Idx As Long
    Dim V As Long
    Idx = N
    V = M - N
    Do
        Index(Idx) = Index(Idx) + 1
        If Index(Idx) > V + Idx Then
            Idx = Idx - 1
        Else
            Exit Do
        End If
    Loop
    Do While Idx < N
        Idx = Idx + 1
        Index(Idx) = Index(Idx - 1) + 1
    Loop
End Sub'输出组合
Private Sub PrintComb(anyInput As Variant, Idx() As Long)
    Dim i As Long
    For i = 1 To UBound(Idx)
        Debug.Print anyInput(Idx(i) - 1); Chr(32);
    Next
    Debug.Print
End Sub
Private Sub GetComb(anyInput As Variant, ByVal N As Long)
    
    Dim M As Long
    Dim Index() As Long
    Dim i As Long, j As Long
    
    M = UBound(anyInput) + 1
    ReDim Index(N)
    For i = 1 To N
        Index(i) = i
    Next
    Index(0) = -1
    
    Do
        PrintComb anyInput, Index
        Carry Index, M, N
    Loop Until Index(0) = 0
    
End SubPrivate Sub Command1_Click()
    
    Dim a    a = Array("04", "07", "12", "15", "20", "21", "27", "28")
    GetComb a, 6
    
End Sub