【VBA】組み合わせ数を求める

n個の要素から、r個を抜き出す組み合わせ数を求めてみた。

とりあえず、コードだけ。
解説は、時間とその気が出来たら、後日www

n = 99 なら、全ての r の組み合わせを出力できる。
n = 100 なら、47 <= r <=53 の時、オーバーフローする。

コード

Public Function nCr(ByVal n As Long, ByVal r As Long) As Variant

    Dim dicD        As Dictionary
    Dim dicM        As Dictionary
    '分母
    Dim lDenominatorMin As Long
    Dim lDenominatorMax As Long
    '分子
    Dim lMoleculeMin    As Long
    Dim lMoleculeMax    As Long
    Dim v           As Variant
    Dim vResult     As Variant
    Dim i           As Long

    Debug.Assert n >= r
    Debug.Assert r > 0

    Set dicD = New Dictionary
    Set dicM = New Dictionary

    If n - r >= r Then
        lDenominatorMax = n - r
    Else
        lDenominatorMax = r
    End If
    lDenominatorMin = 1

    lMoleculeMax = n
    lMoleculeMin = n - lDenominatorMax + 1

    '分母
    For i = lDenominatorMin To lDenominatorMax
        Call primeFactorization(i, dicD)
    Next i

    '分子
    For i = lMoleculeMin To lMoleculeMax
        Call primeFactorization(i, dicM)
    Next i

    '約分処理
    '分母要素から、分子要素を消し込む
    For Each v In dicD.Keys
        Debug.Assert dicD.Item(v) > 0
        Debug.Assert dicM.Exists(v)
        Debug.Assert dicM.Item(v) >= dicD.Item(v)

        If dicM.Item(v) > dicD.Item(v) Then
            dicM.Item(v) = dicM.Item(v) - dicD.Item(v)
        Else
            dicM.Remove v
        End If
    Next v

    '組み合わせ数のオーバーフロー対策として、Decimalを使用する
    vResult = CDec(1)

    For Each v In dicM.Keys
        vResult = vResult * (CDec(v) ^ dicM.Item(v))
    Next v

'    Debug.Print "Result:" & Format(vResult, "#,##0")

    nCr = vResult

End Function

'素因数分解
'例：
'lValue（素因数分解する値）に12を指定した場合、
' 12 = 2 ^2 * 3 ^1
'なので、
'dicPrimeFactorには、
'Key Item
' 2   2
' 3   1
'が格納されて返る
Private Sub primeFactorization(ByVal lValue As Long, ByRef dicPrimeFactor As Dictionary)

    Dim lPrimeFactor    As Long
    Dim lTargetValue    As Long
    Dim v               As Variant

    If dicPrimeFactor Is Nothing Then
        Set dicPrimeFactor = New Dictionary
    End If

    lTargetValue = lValue
    '素因数初期値
    lPrimeFactor = 2

    Do While lTargetValue >= lPrimeFactor * lPrimeFactor
        If (lTargetValue Mod lPrimeFactor) = 0 Then
            If dicPrimeFactor.Exists(lPrimeFactor) Then
                dicPrimeFactor.Item(lPrimeFactor) = dicPrimeFactor.Item(lPrimeFactor) + 1
            Else
                dicPrimeFactor.Add lPrimeFactor, 1
            End If

            lTargetValue = lTargetValue \ lPrimeFactor
        Else
            lPrimeFactor = lPrimeFactor + 1
        End If
    Loop

    '最後に残った物も、素因数なので、追加する
    'lPrimeFactor は、2から始めているので、Keyに1は存在しない。
    If dicPrimeFactor.Exists(lTargetValue) Then
        dicPrimeFactor.Item(lTargetValue) = dicPrimeFactor.Item(lTargetValue) + 1
    ElseIf lTargetValue <> 1 Then
        '1は、結果に影響を与えないので、無視する
        dicPrimeFactor.Add lTargetValue, 1
    End If

End Sub

実行例

for i=1 to 50:? i & ":" & nCr(99,i):next
1:99
2:4851
3:156849
4:3764376
5:71523144
6:1120529256
7:14887031544
8:171200862756
9:1731030945644
10:15579278510796
11:126050526132804
12:924370524973896
13:6186171974825304
14:38000770702498296
15:215337700647490344
16:1130522928399324306
17:5519611944537877494
18:25144898858450330806
19:107196674080761936594
20:428786696323047746376
21:1613054714739084379224
22:5719012170438571889976
23:19146258135816088501224
24:60629817430084280253876
25:181889452290252840761628
26:517685364210719623706172
27:1399667836569723427057428
28:3599145865465003098147672
29:8811701946483283447189128
30:20560637875127661376774632
31:45764000431735762419272568
32:97248500917438495140954207
33:197443926105102399225573693
34:383273503615787010261407757
35:711793649572175876199757263
36:1265410932572757113244012912
37:2154618614921181030658724688
38:3515430371713505892127392912
39:5498493658321124600506947888
40:8247740487481686900760421832
41:11868699725888281149874753368
42:16390109145274293016493707032
43:21726423750712434928840495368
44:27651812046361280818524266832
45:33796659167774898778196326128
46:39674339023040098565708730672
47:44739148260023940935799206928
48:48467410615025936013782474172
49:50445672272782096667406248628
50:50445672272782096667406248628