香港新浪網 MySinaBlog
« 上一篇 | 下一篇 »
Emily | 29th Oct 2006, 11:52 AM | General | (7099 Reads)

平均分: 6.00 | 評分人數: 1

統計1-49 數字組合數量

EH 問題

排列組合1-49號碼, 任選6個不重複, Combin(49,6)=13983816 種排列方式

最小的總和是1 +2 +3 +4+ 5+ 6 = 21, 最大的總和是44+45+46+47+48+49=279 都只有一種排列

請問如何計算另外其他合22-278 的排列數目, 例如合是101,共有58446種排列

 

northwolves:

Function counts(ByVal max As Long, ByVal m As Long, ByVal sums As Long) As Long
Dim temp As Long, i As Long, j As Long

If max >= m And m = 1 Then counts = IIf(sums <= max, 1, 0)
    If max >= m And m = 2 Then
        For i = 1 To max - 1
            For j = i + 1 To max
                If i + j = sums Then counts = counts + 1
            Next
        Next
    End If
If max >= m And m > 2 Then counts = counts(max - 1, m, sums) + counts(max - 1, m - 1, sums - max)
End Function

Sub xxx()
MsgBox counts(49, 6, 101)
End Sub

列出組合 1 (Jay Petrulis):

Sub RunLottoSpecial()
    Call LottoSpecial(49, 101)
End Sub
 

Sub LottoSpecial(Num As Long, TargetVal As Long)
    
    Dim a As Integer, _
        b As Integer, _
        c As Integer, _
        d As Integer, _
        e As Integer, _
        f As Integer
    
    Dim Counter As Long, _
        NumCols As Long, _
        i As Long
    
    Dim arrResults
    
    Application.ScreenUpdating = False
    
    For a = 1 To Num - 5
        For b = a + 1 To Num - 4
            For c = b + 1 To Num - 3
                For d = c + 1 To Num - 2
                    For e = d + 1 To Num - 1
                        For f = e + 1 To Num
                            If a + b + c + d + e + f = TargetVal Then
                                Application.StatusBar = Counter
                                Counter = Counter + 1
                                With ActiveSheet
                                    If Counter Mod 65536 = 0 Then
                                        .Cells(65536, i + 1) = a & "," & b & "," & c & "," & d & "," & e & "," & f
                                        i = i + 1
                                    Else
                                        .Cells(Counter Mod 65536, i + 1) = a & "," & b & "," & c & "," & d & "," & e & "," & f
                                    
End If
                                End With
                            End If
                        Next f
                    Next e
                Next d
            Next c
        Next b
    Next a
    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub

列出組合 2 (Output as Text File):

Sub MultipleLottoSums()
  
  Dim i As Long
  On Error GoTo Er
  Make_TextFile
  Open ActiveWorkbook.Path & "Report.txt" For Output As #1
        For i = 101 To 101   ' Change your Range (Depends on your PC)
           Application.StatusBar = "Finding combination ....Total sum = " & i
                Call LottoSpecial(49, i)
        Next i
           Application.StatusBar = ""
        Close #1
        MsgBox "Check text file .... " & ActiveWorkbook.Path & "Report.txt"
Exit Sub
Er:
MsgBox "Error"
End Sub

Sub LottoSpecial(Num As Long, TargetVal As Long)
    
    Dim a As Integer, _
        b As Integer, _
        c As Integer, _
        d As Integer, _
        e As Integer, _
        f As Integer
    
    Dim Counter As Long, _
        NumCols As Long, _
        i As Long    
    Dim arrResults
    Dim varTemp As String
    
    For a = 1 To Num - 5
        For b = a + 1 To Num - 4
            For c = b + 1 To Num - 3
                For d = c + 1 To Num - 2
                    For e = d + 1 To Num - 1
                        For f = e + 1 To Num
                            If a + b + c + d + e + f = TargetVal Then
                                       varTemp = a & "," & b & "," & c & "," & d & "," & e & "," & f
                                       Write #1, varTemp
                                       varTemp = ""
                            End If
                        Next f
                    Next e
                Next d
            Next c
        Next b
    Next a
End Sub
 

Sub Make_TextFile()
Open ActiveWorkbook.Path & "Report.txt" For Output As #1
Close #1
End Sub

'

mySinaBlog 不支援斜線,斜線現用全形\取代 ,請改回。

 



[1]

How to generalize the 49 into N, and 6 into M ?

I am thinking about it!! Do you have any idea?


[引用] | 作者 Sun | 11th Dec 2006 17:46 PM | [舉報垃圾留言]