| |
▼もも缶 さん：
こんにちは。
>それでも5万件近く組合せがあると思いますが？（多分）
そうですね、6^6とおりですね！！
一応、列Ａ〜Ｇのように列数が増えてもいいようにしました。
標準モジュール（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ぐらいサンプルデータを作成して
テストしてみてください。
|
|
