Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


61399 / 76738 ←次へ | 前へ→

【19959】Re:教えてください 追伸
発言  ichinose  - 04/11/20(土) 1:22 -

引用なし
パスワード
   ▼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 ----組み分け数配列(1次元配列)
>'     delimiter---同一グループ内を区切る文字
>'     組み分け数---グループ化する数
>'     patturnグループメンバ数等の情報(2次元配列)
>'
>'
>'output : dist_array 2次元配列 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グループメンバ数等の情報(2次元配列)
'
'     例1 Array("a", "b", "c", "d", "e", "f", "g", "h")を
'     1,3,4の3グループに分ける場合、
'     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の3グループに分ける場合、
'     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())

2 hits

【19670】教えてください ゆか 04/11/13(土) 16:49 質問
【19673】Re:教えてください Kein 04/11/13(土) 20:22 発言
【19675】Re:教えてください [名前なし] 04/11/13(土) 21:07 発言
【19678】Re:教えてください ichinose 04/11/14(日) 0:15 発言
【19679】Re:教えてください ちゃっぴ 04/11/14(日) 11:34 回答
【19680】Re:教えてください ちゃっぴ 04/11/14(日) 13:56 発言
【19691】ありがとうございます ゆか 04/11/15(月) 12:06 お礼
【19710】教えてください ゆか 04/11/15(月) 16:48 質問
【19946】Re:教えてください hamar 04/11/19(金) 18:39 回答
【19951】Re:教えてください ちゃっぴ 04/11/19(金) 22:15 回答
【19953】Re:教えてください ちゃっぴ 04/11/19(金) 22:21 発言
【19957】Re:教えてください ichinose 04/11/20(土) 0:29 発言
【19958】Re:教えてください ちゃっぴ 04/11/20(土) 0:33 発言
【19959】Re:教えてください 追伸 ichinose 04/11/20(土) 1:22 発言
【20041】ありがとうございました! ゆか 04/11/25(木) 11:42 お礼

61399 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free