此等式：a+(13*b/c)+d+(12*e)-f+(g*h/i)=87在尝试解决最近在互联网上传播的the maths puzzle for Vietnamese eight-year-olds时出现。在数学中，这样的方程称为underdetermined system。当然它有多个解决方案，蛮力方法似乎是找到所有解决方案的最简单方法。
我有兴趣了解如何使用VBA解决方程并在MS Excel工作表中提供解决方案，因为由于缺乏VBA编程知识，我无法找到制作此类程序的方法。
我很清楚Stack Overflow上的类似帖子，如this和this，但那里的答案对我没什么帮助。
这是我的尝试：
Sub Vietnam_Problem()
Dim StartTime As Double
StartTime = Timer
j = 2 'initial value for number of rows
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
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 And a + (13 * b / c) + d + (12 * e) - f + (g * h / i) = 87 Then
Cells(j, 1) = a
Cells(j, 2) = b
Cells(j, 3) = c
Cells(j, 4) = d
Cells(j, 5) = e
Cells(j, 6) = f
Cells(j, 7) = g
Cells(j, 8) = h
Cells(j, 9) = i
j = j + 1
End If
Next i
Next h
Next g
Next f
Next e
Next d
Next c
Next b
Next a
Cells(2, 11) = j - 2 'number of solutions
Cells(2, 12) = Round(Timer - StartTime, 2) 'running time of VBA code
End Sub
它似乎有用，但它不好而且很慢。
答案 0 :(得分：9)
Anastasiya-Romanova秀，因为你没有声明变量（a到j），你的代码运行时那些变量默认为Variant类型。虽然变体非常有用，但不应在此处使用。
我没有改变你的代码，在我的机器上，完成了851秒。
由于VBA针对Longs进行了优化，只需在代码中添加一行以将变量（a到j）声明为Longs，就可以将我的机器上的运行时间降低到120秒。因此，使用适当的变量类型的速度要快7倍！
我在VBA中解决这个难题的速度相当快。事实上，它比目前在此页面上发布的内容要快得多（也更短）。在我的同一台机器上，它会在不到一秒的时间内返回所有136个正确的组合。
有很多废话（世界，网络，甚至在这个页面！）关于VBA太慢了。不要相信。当然，编译的语言可以更快，但在很多时候，它取决于你如何知道如何处理你的语言。自20世纪70年代以来，我一直在用BASIC语言编程。
以下是我为您的问题制作的越南拼图的解决方案。请将其放在新的代码模块中：
Option Explicit
Private z As Long, v As Variant
Public Sub Vietnam()
Dim s As String
s = "123456789"
ReDim v(1 To 200, 1 To 9)
Call FilterPermutations("", s)
[a1:i200] = v
End
End Sub
Private Sub FilterPermutations(s1 As String, s2 As String)
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, j As Long, m As Long, n As Long
n = Len(s2)
If n < 2 Then
a = Mid$(s1, 1, 1): b = Mid$(s1, 2, 1): c = Mid$(s1, 3, 1)
d = Mid$(s1, 4, 1): e = Mid$(s1, 5, 1): f = Mid$(s1, 6, 1)
g = Mid$(s1, 7, 1): h = Mid$(s1, 8, 1): i = s2
If a + (13 * b / c) + d + (12 * e) - f + (g * h / i) = 87 Then
z = z + 1
v(z, 1) = a: v(z, 2) = b: v(z, 3) = c
v(z, 4) = d: v(z, 5) = e: v(z, 6) = f
v(z, 7) = g: v(z, 8) = h: v(z, 9) = i
End If
Else
For m = 1 To n
FilterPermutations s1 + Mid$(s2, m, 1), Left$(s2, m - 1) + Right$(s2, n - m)
Next
End If
End Sub
方法＃2：
Anastasiya，我将在今天晚些时候尝试解释，当我有更多时间。但与此同时，请检查我的下一次尝试。它现在更短，并在大约1/10秒内完成。我现在正在使用Heap的置换算法：
Option Explicit
Private z As Long, v As Variant
Public Sub VietnamHeap()
Dim a(0 To 8) As Long
a(0) = 1: a(1) = 2: a(2) = 3: a(3) = 4: a(4) = 5: a(5) = 6: a(6) = 7: a(7) = 8: a(8) = 9
ReDim v(1 To 200, 1 To 9)
Generate 9, a
[a1:i200] = v
End
End Sub
Sub Generate(n As Long, a() As Long)
Dim t As Long, i As Long
If n = 1 Then
If a(0) + (13 * a(1) / a(2)) + a(3) + (12 * a(4)) - a(5) + (a(6) * a(7) / a(8)) = 87 Then
z = z + 1
For i = 1 To 9: v(z, i) = a(i - 1): Next
End If
Else
For i = 0 To n - 2
Generate n - 1, a
If n Mod 2 = 1 Then
t = a(0): a(0) = a(n - 1): a(n - 1) = t
Else
t = a(i): a(i) = a(n - 1): a(n - 1) = t
End If
Next
Generate n - 1, a
End If
End Sub
方法＃3
这是一个更短的版本。任何人都可以提出更短的版本或更快的版本吗？
Const q = 9
Dim z As Long, v(1 To 999, 1 To q)
Public Sub VietnamHeap()
Dim a(1 To q) As Long
For z = 1 To q: a(z) = z: Next: z = 0
Gen q, a
[a1].Resize(UBound(v), q) = v: End
End Sub
Sub Gen(n As Long, a() As Long)
Dim i As Long, k As Long, t As Long
If n > 1 Then
For i = 1 To n - 1
Gen n - 1, a
If n Mod 2 = 1 Then k = 1 Else k = i
t = a(k): a(k) = a(n): a(n) = t
Next
Gen n - 1, a
Else
If 87 = a(1) + 13 * a(2) / a(3) + a(4) + 12 * a(5) - a(6) + a(7) * a(8) / a(9) Then z = z + 1: For i = 1 To q: v(z, i) = a(i): Next
End If
End Sub
答案 1 :(得分：2)
我打算提交另一个答案，但由于我的上一个答案非常基础，我只是覆盖了它。这仍然使用蒙特卡罗风格的随机数方法，但是当你必须确保你已经用随机数组合解决时，它会变得有点块状。
Sub MonteCarlo()
Dim startTime As Single
startTime = Timer
Dim trialSol As Double
Dim solCounter As Integer
solCounter = 0
Dim trialNums() As Integer
Dim solutions As Collection
Set solutions = New Collection
Dim existingSol As Boolean
existingSol = False
Do
trialNums = CreateRandomArray
trialSol = ToSolve(trialNums(1), trialNums(2), _
trialNums(3), trialNums(4), _
trialNums(5), trialNums(6), _
trialNums(7), trialNums(8), _
trialNums(9))
If trialSol = 87 Then
If Not ExistsIn(solutions, trialNums) Then
solutions.Add (trialNums)
End If
End If
Loop Until (solutions.Count = 128)
Dim solutionTime As Single
solutionTime = Round(Timer - startTime, 5)
Dim i As Integer
For i = 1 To solutions.Count
Debug.Print "Solution " & i & ":"; vbTab; _
solutions.Item(i)(1); vbTab; _
solutions.Item(i)(2); vbTab; _
solutions.Item(i)(3); vbTab; _
solutions.Item(i)(4); vbTab; _
solutions.Item(i)(5); vbTab; _
solutions.Item(i)(6); vbTab; _
solutions.Item(i)(7); vbTab; _
solutions.Item(i)(8); vbTab; _
solutions.Item(i)(9)
Next i
Debug.Print "Solution time: " & solutionTime & " ms"
End Sub
Function ExistsIn(col As Collection, arr() As Integer) As Boolean
Dim ei As Boolean
ei = False
Dim i As Integer
Dim temparr() As Integer
If col.Count > 0 Then
For i = 1 To col.Count
temparr = col.Item(i)
ei = AreEqual(temparr, arr)
Next i
End If
ExistsIn = ei
End Function
Function AreEqual(array1() As Integer, array2() As Integer) As Boolean
Dim eq As Boolean
eq = True
For i = LBound(array1) To UBound(array1)
If array1(i) <> array2(i) Then
eq = False
Exit For
End If
Next i
AreEqual = eq
End Function
Function ToSolve(a As Integer, b As Integer, _
c As Integer, d As Integer, _
e As Integer, f As Integer, _
g As Integer, h As Integer, _
i As Integer) As Double
ToSolve = a + (13 * b / c) + d + (12 * e) - f + (g * h / i)
End Function
Function CreateRandomArray() As Integer()
Dim numbers As New Collection
Dim i As Integer
For i = 1 To 9
numbers.Add i
Next i
Dim rndNums(9) As Integer
Dim rndInd As Integer
For i = 1 To 9
rndInt = CInt(((numbers.Count - 1) * Rnd) + 1)
rndNums(i) = numbers(rndInt)
numbers.Remove (rndInt)
Next i
CreateRandomArray = rndNums
End Function
我所有组合的解决方案时间大约是3s - 3.5s。
答案 2 :(得分：1)
好的，这是我的尝试：
RewriteBase它似乎有效，但正如我在下面的评论部分提到的那样，我的问题并不好，也很慢。
输出：
Sub Vietnam_Problem()
Dim StartTime As Double
StartTime = Timer
j = 2 'initial value for number of rows
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
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 And a + (13 * b / c) + d + (12 * e) - f + (g * h / i) = 87 Then
Cells(j, 1) = a
Cells(j, 2) = b
Cells(j, 3) = c
Cells(j, 4) = d
Cells(j, 5) = e
Cells(j, 6) = f
Cells(j, 7) = g
Cells(j, 8) = h
Cells(j, 9) = i
j = j + 1
End If
Next i
Next h
Next g
Next f
Next e
Next d
Next c
Next b
Next a
Cells(2, 11) = j - 2 'number of solutions
Cells(2, 12) = Round(Timer - StartTime, 2) 'running time of VBA code
End Sub
有128个解决方案，需要时间984.61秒或16分钟和24.61秒。
答案 3 :(得分：1)
Public j As Long '<--new line
Private Sub Permutate(list() As Long, ByVal pointer As Long)
If pointer = UBound(list) Then
Dim lower_bound As Long
lower_bound = LBound(list)
Validate list(lower_bound), list(lower_bound + 1), list(lower_bound + 2), list(lower_bound + 3), list(lower_bound + 4), list(lower_bound + 5), list(lower_bound + 6), list(lower_bound + 7), list(lower_bound + 8)
Exit Sub
End If
Dim i As Long
For i = pointer To UBound(list)
Dim permutation() As Long
permutation = list
permutation(pointer) = list(i)
permutation(i) = list(pointer)
Permutate permutation, pointer + 1
Next
End Sub
Private Sub Validate(ByVal a As Long, ByVal b As Long, ByVal c As Long, ByVal d As Long, ByVal e As Long, ByVal f As Long, ByVal g As Long, ByVal h As Long, ByVal i As Long)
If a + (13 * b / c) + d + (12 * e) - f + (g * h / i) = 87 Then
Cells(j, 1) = a '<--new line
Cells(j, 2) = b '<--new line
Cells(j, 3) = c '<--new line
Cells(j, 4) = d '<--new line
Cells(j, 5) = e '<--new line
Cells(j, 6) = f '<--new line
Cells(j, 7) = g '<--new line
Cells(j, 8) = h '<--new line
Cells(j, 9) = i '<--new line
j = j + 1 '<--new line
'Debug.Print a, b, c, d, e, f, g, h, i
End If
End Sub
Public Sub Vietnam_Problem()
Dim numbers(1 To 9) As Long
Dim i As Long
Dim StartTime As Double
StartTime = Timer
j = 1 '<--new line
For i = 1 To 9
numbers(i) = i
Next
Permutate numbers, LBound(numbers)
Cells(2, 12) = Round(Timer - StartTime, 2)
End Sub
答案 4 :(得分：0)
抱歉 - 无法发表评论。我不会为此使用VBA或其他东西。在我看来，这是像prolog这样的逻辑语言的工作。您可以在here上的zebra-puzzle上看到多种语言的一些示例。
我知道VBA中唯一的方法是使用for循环 - 这不是很快，这不是很好，而且非常有限。这就是为什么我会建议像prolog这样的逻辑语言或像C＃/ C ++这样非常快速的编程语言。对不起，真的无法帮助你。