次の空所には数字の １ 、２ 、３ 、４ 、５ 、６ 、７ 、８ 、９ の何れかがそれぞれ
一つずつ入る。
等式が成り立つようにするには、どのように入れたらよいであろうか？
（答） たとえば、次のように入れればよい。
当ＨＰがいつもお世話になっている らすかる 様より、上記の解は全部で、８２４通りある
旨、メールを頂戴しました。（平成１６年１２月１２日）
その計算結果は、
１＋２×５−７−８÷４−３÷９×６＝０
１＋２×５−７−８÷４−６÷９×３＝０
１＋２×５−８−４÷６−３÷９×７＝０
・・・・・ 途中、省略 ・・・・・
９＋８×１−５−６÷４−７÷２×３＝０
９＋８×４−３−６÷２−５÷１×７＝０
９＋８×４−３−６÷２−７÷１×５＝０
となるそうです。
計算結果をお寄せいただいた らすかる 様に感謝いたします。
でも、８２４個も解があるということは、これは、パズルになりませんでしたね！？
（追記） その後、らすかる 様の研究によれば、四則演算子（＋、−、×、÷）をいろいろ
組み合わせてみたとき、起こりうる全ての場合の数 ６５５３６通りのうち、解をもつ
場合が ４０８７４通りあるとのことである。
しかも、各場合について、解の個数に注目した場合、最大は、１２９６０個、最小は、
４個であるらしい。
解の個数が最大となるパターン ： 「＋」が３個、「−」が４個、「×」が１個を使う場合
このような場合は全部で、８！/（３！４！１！）＝２８０（通り） 存在する。
解の個数が最小となるパターン ： 「×」が１個、「÷」が４個を使う場合
たとえば、
のような場合は、かけ算の入れ替えと割る数同士の入れ替えを考えれば、解は実質
的に、１個しかないとのことである。（こちらを出題すべきでした！．．．．．(^-^;) ）
答の一つとして、 ２×３＋５÷８−７÷１＋９÷４÷６＝０ がある。
らすかる 様によれば、次のような場合も面白そうだとのことである。
（解は全て実質的に、１個しかないそうです。是非、チャレンジしてみて下さい。）
（追々記） 上記の答を記しておきます。この問題は、かなり頭の体操になりますね！
２×５−９＋４÷３÷８−７÷１÷６＝０
９÷２÷３÷６−５÷１÷４＋８−７＝０
１×２×５×７＋４−８×９−６÷３＝０
一番上と一番下は手計算で何とか求められたのですが、真ん中のものはちょっと
Ｅｘｃｅｌ にお手伝い頂きました。（しばらくの間、解の探求に没頭してしまった！）
そのとき用いた ＶＢＡ は、公開するのも恥ずかしい位、拙いものですが．．．．．．。
Sub 小町算()
Dim a, b, c, d, e, f, g, h, i As Integer
Range("a2").Select
For a = 1 To 9
For b = 1 To 9
For c = 1 To 9
For d = 1 To 9
e = 1
f = 4
g = 2
h = 3
i = 6
With ActiveCell
.Value = a
.Offset(0, 1).Value = b
.Offset(0, 2).Value = c
.Offset(0, 3).Value = d
.Offset(0, 4).Value = -a / (e * f) + b / (g * h * i) + c - d
.Offset(0, 5).Value =a + b + c + d + e + f + g + h + i
If .Offset(0, 4).Value > -1 And .Offset(0, 4).Value < 1 And .Offset(0, 5).Value = 45 Then
.Offset(1, 0).Select
Else
.Offset(0, 0).Select
End If
End With
Next d, c, b, a
End Sub
上記の Ｉf 文で、「.Offset(0, 4).Value＝０ 」としてしまうと、Ｅｘｃｅｌ の特性から検出されな
い場合があるということで、ちょっと工夫しています。
計算結果から、-a / (e * f) + b / (g * h * i) + c - d の値で、０ に近いものを探そうと思
ったのですが、ぴったり、０ になる場合がありました。それが上記の解です。
（追記） 平成２３年１０月２０日付け
当ＨＰの読者の方から、上記ＶＢＡの改良版をご教示頂いた。わずか３分あまりで６万件
近い数式が得られることに感動しました！PDFファイルにしてアップしようと思いましたが、
１メガｂｙｔｅを超えるサイズなので断念しました。ご教示いただきありがとうございました。
Excel 2000 〜 2003 対応です。Sheet1 という名前のシートがあること。
2.8GHz Pentium-4 のパソコンで、３分弱かかります。
Sub 小町算_2()
Dim a As Integer, b As Integer, c As Integer
Dim d As Integer, e As Integer, f As Integer
Dim g As Integer, h As Integer, i As Integer
Dim n1 As Long, n2 As Long
Dim s As String
Dim a1(2), a2(5), a3(5), a4(5), a5(5), a6(5), a7(5), a8(5), a9(5)
Dim Start As Single, Finish As Single, Tm As Integer
Dim msg_Tm As String, moto As Variant
moto = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Start = Timer
a1(1) = "+": a1(2) = "-"
a2(1) = "": a2(2) = "+": a2(3) = "-": a2(4) = "*": a2(5) = "/"
a3(1) = "": a3(2) = "+": a3(3) = "-": a3(4) = "*": a3(5) = "/"
a4(1) = "": a4(2) = "+": a4(3) = "-": a4(4) = "*": a4(5) = "/"
a5(1) = "": a5(2) = "+": a5(3) = "-": a5(4) = "*": a5(5) = "/"
a6(1) = "": a6(2) = "+": a6(3) = "-": a6(4) = "*": a6(5) = "/"
a7(1) = "": a7(2) = "+": a7(3) = "-": a7(4) = "*": a7(5) = "/"
a8(1) = "": a8(2) = "+": a8(3) = "-": a8(4) = "*": a8(5) = "/"
a9(1) = "": a9(2) = "+": a9(3) = "-": a9(4) = "*": a9(5) = "/"
Application.ScreenUpdating = False
With Sheets("Sheet1")
.Columns("A:E").ClearContents
.Cells(1, 1).Value = "計算値"
.Cells(1, 2).Value = "計算式"
.Cells(1, 4).Value = "計算値"
.Cells(1, 5).Value = "計算式"
n1 = 2: n2 = 2
For a = 1 To 2
For b = 1 To 5
For c = 1 To 5
For d = 1 To 5
Application.StatusBar _
= "計算中 ： a = " & a & " : b = " & b & " : c = " & c & " : d = " & d
For e = 1 To 5
For f = 1 To 5
For g = 1 To 5
For h = 1 To 5
For i = 1 To 5
s = "=" & a1(a) & "1" & a2(b) & "2" & a3(c) & "3" _
& a4(d) & "4" & a5(e) & "5" & a6(f) & "6" _
& a7(g) & "7" & a8(h) & "8" & a9(i) & "9"
.Cells(1, 3).Formula = s
If .Cells(1, 3).Value = Int(.Cells(1, 3).Value) _
And Abs(.Cells(1, 3).Value) <= 1000 Then
If .Cells(1, 3).Value >= 0 Then
.Cells(n1, 1).Value = .Cells(1, 3).Value
.Cells(n1, 2).Value = "'" & s
n1 = n1 + 1
Else
.Cells(n2, 4).Value = .Cells(1, 3).Value
.Cells(n2, 5).Value = "'" & s
n2 = n2 + 1
End If
End If
Next i, h, g, f, e, d, c, b, a
.Cells(1, 3).ClearContents
' Sort
.Range(.Cells(1, 1), .Cells(n1, 2)).Sort _
Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes
.Range(.Cells(1, 4), .Cells(n1, 5)).Sort _
Key1:=.Range("D2"), Order1:=xlDescending, Header:=xlYes
.Cells(1, 1).Select
End With
Finish = Timer: Tm = Round(Finish - Start)
Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = moto
If Tm >= 60 Then
msg_Tm = Int(Tm / 60) & "分 " & Tm Mod 60 & "秒"
Else
msg_Tm = Tm & "秒"
End If
MsgBox "お待たせしました。 （所要時間 ： " & msg_Tm & "）"
End Sub