Excel VBA質問箱 IV

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

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


12121 / 13645 ツリー ←次へ | 前へ→

【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 発言

【12226】質問の補足です。
発言  もも缶  - 04/3/27(土) 0:45 -

引用なし
パスワード
   すみません。考えすぎて脳みそが飛んでました。
A列から最大F列にはそれぞれ4〜6行まで数値があり
つまり最大36個の数値の組み合わせになります。
過去ログも参照しましたが、みつけられませんでした。
よろしくご指導ください。尚期待数値"X"は小数点三位四捨五入
で得た数値となります。

【12230】Re:質問の補足です。
回答  IROC  - 04/3/27(土) 13:24 -

引用なし
パスワード
   補足なら同じ質問のトピックに「返信」で
書き込まないと意味がないですよ?

どちらのトピックで質疑を続けるおつもりでしょうか?

【12231】Re:質問の補足です。
発言  ichinose  - 04/3/27(土) 13:54 -

引用なし
パスワード
   こんにちは。

>すみません。考えすぎて脳みそが飛んでました。
>A列から最大F列にはそれぞれ4〜6行まで数値があり
>つまり最大36個の数値の組み合わせになります。
>過去ログも参照しましたが、みつけられませんでした。
>よろしくご指導ください。尚期待数値"X"は小数点三位四捨五入
>で得た数値となります。
仕様を確認させていただけますか?

36個の数値の組み合わせの乗算・・・、
例えば、この数値が1〜36だとして、
1*2
1*3
1*4



という二つの数値の積のみでよろしいのですか?(これだと比較的簡単ですが)
それとも、

1*2*3



1*2*3*4

も含めた組み合わせですか?


36の数値の中の2つ以上、36以下の組み合わせの積となると、
組み合わせロジックから考えなければなりませし、

例えば、
36の数値から18個の数値を選ぶ組み合わせなんて、
  9075135300とおり
なんていう天文学的な数字になってしまいますね?

ここのところの仕様は、どうなんでしょうか?

【12232】Re:質問の補足です。
質問  もも缶  - 04/3/27(土) 13:59 -

引用なし
パスワード
   すみませんでした。押し間違えてしまいました。
このトピックでお願いします。
尚、さらに補足しますと…
乗算していく数値は、A列から1個、B列から一個…
というように組み合わせ、つまり同じ列の数値は掛けません。

【12233】Re:質問の補足です。
質問  もも缶  - 04/3/27(土) 14:48 -

引用なし
パスワード
     A   B   C   D   E   F
1
2
3
4
5
6

A1からF6までのセルに数値が入っているとして、

A1*B1*C1*D1*E1*F1といき、
次に
A1*B2*C1*D1*E1*F1→A1*B3*C1*D1*E1*F1→A1*B4*C1*D1*E1*F1…
さらに
A1*B1*C2*D1*E1*F1→A1*B1*C3*D1*E1*F1→A1*B1*C4*D1*E1*F1…

という具合です。つまり各列から一個選択された数値を掛け合わせて
希望の数値をだしてくれる組合せを抽出したいのです。
それでも5万件近く組合せがあると思いますが?(多分)
私のような初心者には敷居が高いでしょうか。

【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ぐらいサンプルデータを作成して
テストしてみてください。

【12237】Re:質問の補足です。
お礼  もも缶  - 04/3/27(土) 16:01 -

引用なし
パスワード
   本当にありがとうございます。(深々とm(_ _)m)
早速やってみま〜す。

【12238】Re:質問の補足です。
お礼  もも缶  - 04/3/27(土) 16:58 -

引用なし
パスワード
   できましたっ。(^^)/
F列までで、46656通り、G列までだと 279936通りを
あっちゅう間にやってくれました。
ichinoseさん、感嘆しました。まるで神様のようなお方です。

私には到底書けないような構文ばかりなので、
これから参考書片手に、1行づつ自分なりに解読
していこうと思います。
ありがとうございました。そしてこれからもよろしく
お願いいたします。(深々とm(_ _)m)

【12250】図々しいのですが…
質問  もも缶  - 04/3/28(日) 9:54 -

引用なし
パスワード
   こんにちわ。
あれから、MSGBOXででた組合せ結果を表の下のセルに1行づつ
表示させたいと思い、試行錯誤したのですがうまくいきません。
どうか教えて下さい。

【12256】できました!
発言  もも缶  - 04/3/28(日) 14:49 -

引用なし
パスワード
   If 期待値 = Application.Evaluate("=round(" & Join(ans(), "*") & ",3)")   _Then     
       Range("C65536").End(xlUp).Offset(1).Select
       Selection.Value = Join(ans(), " * ") & " = " & 期待値
 End If

…で配列がよくわからない私なりに、やっと解決にこぎつけました。
それまでは無限ループで汗かきましたが。
お騒がせいたしました。

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