Excel VBA質問箱 IV

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

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


75702 / 76732 ←次へ | 前へ→

【5462】Re:数字の組みあわせ方
回答  ichinose  - 03/5/15(木) 0:39 -

引用なし
パスワード
   ▼さくら さん:
こんばんは。
さくらさんの意図した結果ではなかったみたいですが、Function combの引数の変更でいけますよね?

で、combの中身の説明ですが、コード見ておわかりだと思いますが、リカーシブルになっています。本当は、なるべくこういうコードは書かないようにしているのですが(非常にメンテナンスしづらいですよね、ちょっと前まで北朝鮮拉致ドラマ見てウルウルしてたらもう自分でもコード解析が大変です)、第1印象でこれしかないだろうと思ってしまったもので・・・。
コメントを付けようかと思いましたが、付けても説明がわかりづらいだろうと思いましたので、コードの考え方だけ。

仮に組み合わせのメンバーを
  
1 2 3 4 5とし、
抜き取り数を3と限定しましょう。
1列   2列   3列
1    2    3
1    2    4
1    2    5
1    3    4
1    3    5
1    4    5
2    3    4
2    3    5
2    4    5
3    4    5

組み合わせリストは上記の10通りになりますが、
規則性として、各行とも1列<2列<3列 となっていますよね。
よって、配列の引数はこの条件を満たしながら変化させ、各列の値をひとつづつ変化させるロジックを考えました。


'=====================================================================
Function comb(ans(), Optional rng As Range = Nothing, Optional seln As Long = 0, Optional ByVal myx As Long = 0, Optional ByVal ctx As Long = 0) As Long
'input rng : 組み合わせメンバーセル範囲
'   seln: 抜き取り数
'out  ans() 組み合わせリスト
‘   comb 組み合わせ総数
'   mxy ctx は 内部パラメータ指定不可
  Dim crng As Range
  Static svn As Long
  Static myarray()
  Static idx As Long
  Static gyou As Long
  Static mylim As Long
  Dim cnt As Long
  If seln > 0 Then
  ‘最初に呼び出されたときの初期設定を行います
  ‘リカーシブルによる2回目以降には実行されません
  svn = seln
    Erase myarray
    i = 1
    For Each crng In rng
     ReDim Preserve myarray(1 To i)
     myarray(i) = crng.Value
     i = i + 1
     Next
    ‘このループで組み合わせ要素を1次元の配列に移行しています
    mylim = rng.Count
    myx = 1 ‘myarrayのインデックス
    gyou = WorksheetFunction.Combin(rng.Count, seln) ‘組み合わせ数の算出
    comb = gyou
    ReDim ans(1 To gyou, 1 To svn) ‘組み合わせリストのエリア確保
    ctx = 1 ‘配列ansの列のインデックス
    idx = 1 ‘‘配列ansの行のインデックス
    End If
  cnt = 0
  Do While myx <= mylim And idx <= gyou
   If cnt > 0 And idx > 1 Then
     For i = 1 To ctx - 1
      ans(idx, i) = ans(idx - 1, i)
      Next
     End If
   ‘↑のループで当該列の直前までの列の要素をコピー
   ans(idx, ctx) = myarray(myx)
   ‘↑このコードをループさせることで一つの列を配置を完成させていきます
   If ctx + 1 <= svn Then ‘抜き取り数に達していなければ、リカーシブルコール
     Call comb(ans(), , , myx + 1, ctx + 1)
     End If
   myx = myx + 1
   idx = idx + 1
   cnt = cnt + 1
   Loop
  idx = idx - 1
End Function

前述したようにコメントも付けにくいし、付けてもわかりづらいと思いますが・・。

1 hits

【5435】数字の組みあわせ方 さくら 03/5/13(火) 20:45 質問
【5456】Re:数字の組みあわせ方 ichinose 03/5/14(水) 18:39 回答
【5458】Re:数字の組みあわせ方 さくら 03/5/14(水) 19:55 質問
【5462】Re:数字の組みあわせ方 ichinose 03/5/15(木) 0:39 回答
【5481】Re:数字の組みあわせ方 さくら 03/5/15(木) 14:41 お礼

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