この問題を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 · ベストアンサー

一番頭の悪いやり方です。試行錯誤してスマートな書き方を考えてみてください。

※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初心者なので大変参考になりました。

回答No.10

BLUEPIXY

'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」が１個多くなりました。

お礼

すごい。

試してみます。

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

回答No.9

imogasi

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

回答No.8

Wendy02

こんばんは。

最初、解がいくつあるか数えてみたところ、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))

お礼

いや～　恐れ入りました。

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

早そうですね!?

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

回答No.7

todo36

回答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)

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

回答No.6

1050 円（@1050YEN）

再帰を利用した関数化を行う授業かな？
みなさんが言うように、アルゴリズムを考えましょう

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

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

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

お礼

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

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

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

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

回答No.5

lasichi

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

補足

おっしゃるとおりです。

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

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

回答No.4

shizuku1023

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

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
です。

回答No.2

wakin

ヒント：For ～ Next、入れ子

お礼

ありがとう

回答No.1

neKo_deux

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

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

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

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

お礼

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

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

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