Excel VBA質問箱 IV

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

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


69018 / 76734 ←次へ | 前へ→

【12236】Re:質問の補足です。
回答  ichinose  - 04/3/27(土) 15:50 -

引用なし
パスワード
   ▼もも缶 さん:
こんにちは。
>それでも5万件近く組合せがあると思いますが?(多分)

そうですね、6^6とおりですね!!
一応、列A〜Gのように列数が増えてもいいようにしました。

標準モジュール(Module1)に
'=========================================================
Sub main()
  Dim ans()
'  ↑組み合わせメンバーを取得する配列
  Dim rng As Range
'  ↑組み合わせセル範囲(こういうの組み合わせって言うんだっけ?)
  Set rng = Selection
  期待値 = 9.283 '積がこの数値と一致するデータを取得する
  ReDim ans(1 To rng.Columns.Count)
  combcnt = comb_init(rng) '総当り数取得
  Do While get_comb(ans()) = 0
    If 期待値 = Application.Evaluate("=round(" & Join(ans(), "*") & ",3)") Then '積と期待値が一致したらメッセージ(四捨五入だから大丈夫かな?)
     MsgBox Join(ans(), "*") & "=" & 期待値


     End If
    Loop
  MsgBox "以上" & combcnt & "通り調査しました"
End Sub


標準モジュール(module2)に
'===================================================================
  Private c_myarray()
  Private c_idx() As Long
'===================================================================
Function comb_init(rng As Range) As Double
'組み合わせデータをセットする
'input : rng 組み合わせセル範囲
'output: comb_init 組み合わせ総数
  c_svn = seln
  Erase c_myarray
  Erase c_idx
  With rng
   c_myarray() = .Value
   comb_init = .Rows.Count ^ .Columns.Count
   ReDim c_idx(1 To .Columns.Count)
   For idx = LBound(c_idx()) To UBound(c_idx())
     c_idx(idx) = 1
     Next
   c_idx(UBound(c_idx())) = 0
   End With
End Function
'======================================================================
Function get_comb(ans()) As Long
'組み合わせメンバーを配列に出力する
'output: ans() メンバの配列
'    get_comb:0 -- 正常に配列取得
'         1 -- メンバの終わり
  get_comb = 1
  For i = UBound(c_idx()) To LBound(c_idx()) Step -1
    If c_idx(i) + 1 <= UBound(c_myarray(), 1) Then
     c_idx(i) = c_idx(i) + 1
     get_comb = 0
     Exit For
    Else
     c_idx(i) = 1
     End If
    Next
  If get_comb = 0 Then
    For i = LBound(c_idx()) To UBound(c_idx())
     ans(i) = c_myarray(c_idx(i), i)
     Next
    End If
End Function

調査するセル範囲(A1:F6のように)を選択後、mainを実行して下さい。

私も簡単なテストしかしていませんので
最初は、A1:C3ぐらいサンプルデータを作成して
テストしてみてください。
0 hits

【12226】質問の補足です。 もも缶 04/3/27(土) 0:45 発言
【12230】Re:質問の補足です。 IROC 04/3/27(土) 13:24 回答
【12232】Re:質問の補足です。 もも缶 04/3/27(土) 13:59 質問
【12231】Re:質問の補足です。 ichinose 04/3/27(土) 13:54 発言
【12233】Re:質問の補足です。 もも缶 04/3/27(土) 14:48 質問
【12236】Re:質問の補足です。 ichinose 04/3/27(土) 15:50 回答
【12237】Re:質問の補足です。 もも缶 04/3/27(土) 16:01 お礼
【12238】Re:質問の補足です。 もも缶 04/3/27(土) 16:58 お礼
【12250】図々しいのですが… もも缶 04/3/28(日) 9:54 質問
【12256】できました! もも缶 04/3/28(日) 14:49 発言

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