| |
▼ichinose さん：
>こんばんは。
>一週間たってしまいましたね・・・。
>私も作ったので、よかったら検証してみてください。
>まず、標準モジュール（Module1）に
>'========================================================
>Sub test()
> Dim 組合せ
> Dim 組み分け数 As Long
> 組み分け数 = 3
> in_array = Array("A", "B", "C", "D", "E", "F", "G", "H")
> Call mk_pat_init(UBound(in_array) - LBound(in_array) + 1, 組み分け数)
> st = 1
> jdx = 1
'↑これ、要りません
> Do While mk_pat(pat) = 0
> 組合せ = dist_array(in_array, "", 組み分け数, pat)
> Range(Cells(st, 1), Cells(st + UBound(組合せ, 1), 組み分け数)).Value = _
> 組合せ
> st = st + UBound(組合せ, 1) + 1
> Loop
>End Sub
>
>'=======================================================================
>Function dist_array(ByVal in_array, ByVal delimter As String, ByVal 組み分け数 As Long, ByVal patturn, _
> Optional ByVal pdx As Long = 0, Optional ByVal nest As Long = 0, Optional ByVal dupmd As Long = 0)
>'指定された配列を指定された組み分け数でグループ化する
>'グループ化の詳細は、配列Patturnの値による
>'input : in_array ----組み分け数配列（１次元配列)
>' delimiter---同一グループ内を区切る文字
>' 組み分け数---グループ化する数
>' patturnグループメンバ数等の情報（２次元配列）
>'
>'
>'output : dist_array ２次元配列 1次元目がメンバ数
>' 2次元目がグループ化されたメンバの組合せ
>'pdx nest dupmdは、指定不可 内部処理データ
> Static dup() As Class1
> Static ans()
> Static adx As Long
> Static c_array()
> If nest = 0 Then
> menum = 1
> d_cnt = UBound(in_array) - LBound(in_array) + 1
> With WorksheetFunction
> For ll = LBound(patturn) To UBound(patturn)
> For jj = 1 To patturn(ll, 1)
> menum = menum * .Combin(d_cnt, patturn(ll, 0))
> d_cnt = d_cnt - patturn(ll, 0)
> Next jj
> menum = menum / .Fact(patturn(ll, 1))
> Next ll
> End With
> ReDim ans(menum - 1, 組み分け数 - 1)
> ReDim c_array(組み分け数 - 1)
> ReDim dup(UBound(in_array))
> adx = 0
> pdx = 0
> If patturn(pdx, 1) > 1 Then
> dupmd = 1
> Else
> dupmd = 0
> End If
> End If
> If patturn(pdx, 1) = 0 Then
> If pdx + 1 <= UBound(patturn, 1) Then
> pdx = pdx + 1
> If patturn(pdx, 1) > 1 Then
> dupmd = 1
> Else
> dupmd = 0
> End If
> Else
> Exit Function
> End If
> End If
> If dupmd >= 1 Then
> Set dup(nest) = New Class1
> dup(nest).duparray_init UBound(in_array)
> End If
> patturn(pdx, 1) = patturn(pdx, 1) - 1
> myarray1 = combin_list(in_array, patturn(pdx, 0))
> For idx = LBound(myarray1, 1) To UBound(myarray1, 1)
> ReDim tmp(UBound(myarray1, 2))
> For jdx = LBound(myarray1, 2) To UBound(myarray1, 2)
> tmp(jdx) = myarray1(idx, jdx)
> Next jdx
> retcode = 0
> If dupmd > 1 Then
> For dpx = nest - dupmd + 1 To nest - 1
> retcode = dup(dpx).duparray_chk(tmp())
> If retcode <> 0 Then Exit For
> Next dpx
> End If
> If retcode = 0 Then
> If dupmd >= 1 Then
> dup(nest).duparray_put myarray1(idx, 0)
> End If
> c_array(nest) = Join(tmp(), delimter)
> If nest = 組み分け数 - 1 Then
> For kdx = LBound(c_array()) To UBound(c_array())
> ans(adx, kdx) = c_array(kdx)
> Next kdx
> adx = adx + 1
> End If
> myarray2 = except_array(in_array, tmp())
> Erase tmp()
> Call dist_array(myarray2, delimter, 組み分け数, patturn, pdx, nest + 1, dupmd + 1)
> End If
>
> Next idx
> If nest = 0 Then
> dist_array = ans()
> Erase ans()
> Erase c_array()
> On Error Resume Next
> For idx = UBound(dup()) To LBound(dup())
> If Not dup(idx) Is Nothing Then
> dup(idx).duparray_term
> End If
> Set dup(idx) = Nothing
> Next
> Erase dup()
> On Error GoTo 0
> End If
>End Function
patturnという2次元配列の説明です。
一回で投稿できませんでした。
' patturnグループメンバ数等の情報（２次元配列）
'
' 例1 Array("a", "b", "c", "d", "e", "f", "g", "h")を
' 1,3,4の３グループに分ける場合、
' dim pat(2,1)
' メンバ数 メンバ数の重複回数
' pat(0,0)=1 pat(0,1)=1
' pat(1,0)=3 pat(1,1)=1
' pat(2,0)=4 pat(2,1)=1
' 組み分け数 = 3
' 組合せ = _
dist_array(Array("a", "b", "c", "d", "e", "f", "g", "h"),"**", 組み分け数, pat())
'
'
' 例2 Array("a", "b", "c", "d", "e", "f", "g", "h")を
' 3,3,2の３グループに分ける場合、
' dim pat(1,1)
' メンバ数 メンバ数の重複回数
' pat(0,0)=3 pat(0,1)=2
' pat(1,0)=2 pat(1,1)=1
' 組み分け数 = 3
' 組合せ = _
dist_array(Array("a", "b", "c", "d", "e", "f", "g", "h"),"**", 組み分け数, pat())
'
' 例3 Array("a", "b", "c", "d", "e", "f", "g", "h")を
' 2,2,2,2の4グループに分ける場合、
' dim pat(0,1)
' メンバ数 メンバ数の重複回数
' pat(0,0)=2 pat(0,1)=4
' 組み分け数 = 4
' 組合せ = _
dist_array(Array("a", "b", "c", "d", "e", "f", "g", "h"), "**",組み分け数, pat())
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
