この問題をVBAで解くには?

お世話になります。
こんな問題があるとします。

A/(B*C)+D/(E*F)+G/(H*I)=1
A～Iまで１～９までの数値をすべて代入して式が正しくなるようにせよ。

答えは2/(1*4)+5/(3*6)+8/(4*9)=1なのですが、これをVBかVBAで解くにはどんなソースをくめばいいのでしょう?

素人なのでソース付きで解説いただけたらありがたいです。
よろしくお願いいたします。m(__)m

No.3 ベストアンサー 回答者： lasichi 回答日時： 2005/07/25 17:08

一番頭の悪いやり方です。

試行錯誤してスマートな書き方を考えてみてください。

※9種類の1～9までの変数を用意してそれぞれループさせる
For a = 1 To 9
For b = 1 To 9
For c = 1 To 9
For d = 1 To 9
For e = 1 To 9
For f = 1 To 9
For g = 1 To 9
For h = 1 To 9
For i = 1 To 9

※9種類の変数が全てバラバラの数字の場合だけ式を計算する
If (a <> b And a <> c And a <> d And a <> e And a <> f And a <> g And a <> h And a <> i) And _
(b <> c And b <> d And b <> e And b <> f And b <> g And b <> h And b <> i) And _
(c <> d And c <> e And c <> f And c <> g And c <> h And c <> i) And _
(d <> e And d <> f And d <> g And d <> h And d <> i) And _
(e <> f And e <> g And e <> h And e <> i) And _
(f <> g And f <> h And f <> i) And _
(g <> h And g <> i) And _
(h <> i) Then

※式に当てはめて計算させる
If a / (b * c) + d / (e * f) + g / (h * i) = 1 Then

※式が正しかったら結果を表示して終了
　　MsgBox a & "/ (" & b & " * " & c & ") + " & d & "/ (" & e & "* " & f & ") + " & g & "/ (" & h & "* " & i & ") = 1"
End
End If
End If

Next i
Next h
Next g
Next f
Next e
Next d
Next c
Next b
Next a

※全ての組み合わせを試しても式が一致しなかった場合
MsgBox "見つかりませんでした"

この回答へのお礼

お礼が遅くなって申し訳ありません。

なるほど～
恥ずかしながらVB初心者なので大変参考になりました。

お礼日時：2005/07/26 09:29

No.10 回答者： BLUEPIXY 回答日時： 2005/07/26 08:13

'A/(B*C)+D/(E*F)+G/(H*I)=1

'A*(E*F)(H*I)+D*(B*C)(H*I)+G(B*C)(E*F)=(B*C)(E*F)(H*I)
'(H*I){A*(E*F)+D*(B*C)}+G(B*C)(E*F)=(B*C)(E*F)(H*I)
'(H*I){A*(E*F)+(B*C){D-(E*F)}}+G(B*C)(E*F)=0

Dim c
Private Function calc(str As String) As Long'点検
Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long, g As Long, h As Long, i As Long
Dim bc As Long, ef As Long
a = 1 * Mid(str, 1, 1)
b = 1 * Mid(str, 2, 1)
c = 1 * Mid(str, 3, 1)
d = 1 * Mid(str, 4, 1)
e = 1 * Mid(str, 5, 1)
f = 1 * Mid(str, 6, 1)
g = 1 * Mid(str, 7, 1)
h = 1 * Mid(str, 8, 1)
i = 1 * Mid(str, 9, 1)
bc = b * c
ef = e * f
calc = h * i * (a * ef + bc * (d - ef)) + g * bc * ef
End Function
Private Sub rp(ByVal result As String, ByVal selectList As String)
Dim i, strLen As Integer, choice As String
strLen = Len(selectList)
If strLen = 1 Then
If (calc(result & selectList) = 0) Then
Range("A1").Offset(c).Value = result & selectList
c = c + 1
End If
Else
For i = 1 To strLen
choice = Mid(selectList, i, 1)
Call rp(result & choice, Replace(selectList, choice, ""))
Next
End If
End Sub
Public Sub exec()
c = 0
Call rp("", "123456789")
End Sub
-------------------------------------------------------------------
昔に作った順列作成プログラムを使い回して、文字列でパターンを作っているので、かなり遅いです。
マクロの実行でexecを実行します。
結果は、ワークシートに表示されます。
解は４８個で、＃８さんより
「742136598」が１個多くなりました。

この回答へのお礼

すごい。

試してみます。

どうもありがとうございました

お礼日時：2005/07/26 09:42

No.9 回答者： imogasi 回答日時： 2005/07/25 21:55

こういう問題はクイズの問題しょう。

こんなのをＶＢなどの言語で解こうと考えるのは無理があります。
９文字を１－９まで変化させるプログラムなど・・。
多分このクイズのヒントには、特有の着眼点があって、整数になるや、１以下・１丁度、０でない、同じ数字は使わないなどの性格・制約を最大限活用してるはずです。
それはプログラムの条件には取り入れにくいのです。
プログラムで虫食い算をはじめクイズ的問題を解く本も見たことがありますが。
むしろアルゴリズムを考えるに長けた、数学者（整数論）物理学者の卵が集うサイトを見つけてはどうでしょう。
ＯＫＷＥＢのコンピュタカテゴリで数学・物理の質問の回答の少なさからして、あまり期待はできないでしょう。

No.8 回答者： Wendy02 回答日時： 2005/07/25 21:01

こんばんは。

最初、解がいくつあるか数えてみたところ、47個出でてきたので、検算を含めて出力に、Excelのシートを使いました。アルゴリズムは、再帰を使ってみました。

Option Explicit
Const N As Integer = 9
Dim cnt As Long
Dim p(N)
Dim msg As String
Sub test_perm()
Dim i
　msg = ""
　Erase p()
　For i = 1 To N
　　p(i) = i
　Next i
　　perm 1
　If msg = "" Then
　　MsgBox "解が見つかりません。"
　Else
　　cnt = UBound(Split(msg, ","))
　　Cells(1, 1).Resize(cnt).Value = Application.Transpose(Split(msg, ","))
　　MsgBox "終了"
　End If
End Sub
Private Sub perm(i As Variant)
　Dim a As Double, j As Integer, t As Integer
　If i < N Then
　　For j = i To N
　　　t = p(i): p(i) = p(j): p(j) = t
　　　perm i + 1
　　　t = p(i): p(i) = p(j): p(j) = t
　　Next j
　End If
　　a = p(1) / (p(2) * p(3)) + p(4) / (p(5) * p(6)) + p(7) / (p(8) * p(9))
　　If a = 1# Then
　　 If InStr(msg, Join(p(), "")) = 0 Then
　　 msg = msg & "," & Join(p, "")
　　 End If
　　Else
　　End If
End Sub


重複は、フィルタ・オプションで調べ、検算の仕方は、以下のような式を使いました。

=MID(A2,1,1)/(MID(A2,2,1)*MID(A2,3,1))+MID(A2,4,1)/(MID(A2,5,1)*MID(A2,6,1))+MID(A2,7,1)/(MID(A2,8,1)*MID(A2,9,1))

この回答へのお礼

いや～　恐れ入りました。

まだ試していないので試してみます。

早そうですね!?

どうもありがとうございました

お礼日時：2005/07/26 09:38

No.7 回答者： todo36 回答日時： 2005/07/25 19:43

回答3のように9重ループを回すが、すこし工夫してみた。

(1)
対象性から

A < D < G
B < C
E < F
H < I

と仮定してよい。

(2)
A, D, G, B, C, E, F, I, Hの順でループを回す。

For a = 1 To 9
For d = a + 1 To 9
For g = d + 1 To 9
For b = 1 To 9
If Not (b = a Or b = d Or b = g) Then
For c = b + 1 To 9
If Not (c = a Or c = d Or c = g) Then
'中略
End If
Next c
End If
Next b
Next g
Next d
Next a

この回答へのお礼

なんかの先生ですか?

私はアフォなんでよく理解できません(T.T)

どうもありがとうございました

お礼日時：2005/07/26 09:37

No.6 回答者： 1050YEN 回答日時： 2005/07/25 17:59

再帰を利用した関数化を行う授業かな？

みなさんが言うように、アルゴリズムを考えましょう

※まずパターン化します
　A/(B*C) + D/(E+F) + G/(H*I)
　={A/(B*C)} + {D/(E+F)} + {G/(H*I)}
　=あ+い+う
　(#「い」には「あ」が利用している整数値を含まない)
　(#「う」には「あ」/「い」が利用している整数値を含まない)
　(#「あ」「い」「う」はそれぞれ{a/(b*c)}という構造で成立する)



※上記から以下のような、重複パターンが想像できます。
あ+い+う
あ+う+い
い+あ+う
・・・・



こういった考えをしたら、簡潔な関数ができませんか？

この回答へのお礼

皆さん頭がいいですね。。

ちなみに授業ではないです。

もう少しにらめっこして勉強してみます。

どうもありがとうございました

お礼日時：2005/07/26 09:36

No.5 回答者： lasichi 回答日時： 2005/07/25 17:19

No3のものですが、、

答えは
1 / (3 * 6) + 5 / (8 * 9) + 7 / (2 * 4) = 1
だと思いますよ。
そこに載せたソースで出てきます。
(時間は凄くかかりますが。。)

この回答への補足

おっしゃるとおりです。

ソースありがとうございます。
こんなに早くレスがくるとは思わなかったので。。

しばらくにらめっこして研究します。

補足日時：2005/07/25 17:25

No.4 回答者： shizuku1023 回答日時： 2005/07/25 17:09

まず問題の条件に疑問があります。

1.答えに「4」が2回使われていて、「7」が有りません。

2.「2/(1*4)」の解は、「0.5」であり有限小数です。
「5/(3*6)」や「8/(4*9)」の解は、「0.2{7}」と「0.{2}」であり無限小数です。
計算結果が「1」の近似値でも良いのですか？

ソースがどうなるかはアルゴリズム次第です。
アルゴリズムを考えてみましょう。

参考URL：http://ja.wikipedia.org/wiki/小数

この回答への補足

すみません。
答えが間違っていました。

1/(3*6) + 5/(8*9) + 7/(2*4) = 1
です。

補足日時：2005/07/25 17:23

No.2 回答者： wakin 回答日時： 2005/07/25 16:57

ヒント：For ～ Next、入れ子

この回答へのお礼

ありがとう

お礼日時：2005/07/26 09:43

No.1 回答者： neKo_deux 回答日時： 2005/07/25 16:46

まずは問題を簡単にして、

1)
A=1
Aに１～９までの数値をすべて代入して式が正しくなるようにせよ。

2)
A+B=2
A～Bに１～９までの数値をすべて代入して式が正しくなるようにせよ。

ではどんなソースをくめばいいのか、わかりますか？

この回答へのお礼

お礼が遅くなりました。(m_m)

だいたいはイメージできるのですが、思った通りに動かないんです。
他の方の回答で「あぁなるほど」と思いました。

どうもありがとうございました。

お礼日時：2005/07/26 09:27