excel - The brute force method using VBA for solving an equation with nine unknown variables

Question

This equation: a+(13*b/c)+d+(12*e)-f+(g*h/i)=87 appears when trying to solve the maths puzzle for Vietnamese eight-year-olds that recently became viral all over the Internet. In mathematics, such an equation is called an underdetermined system. Of course it has more than one solution and the brute force method seems to be the easiest way to find all of the solutions.

I'm interested in knowing how to solve the equation using VBA and present the solutions in an MS Excel worksheet, since I can't find a way to make such program due to my lack of VBA programming knowledge.

I'm aware of similar posts on Stack Overflow like this and this but the answers there do not help me much.

Here is my attempt:

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

It seems to work but it's not nice and very slow.

Answer 1

Anastasiya-Romanova 秀, since you are not declaring the variables (a through j), your code is running with those variables defaulting to the Variant type. While variants can be enormously useful, they should not be used here.

I ran your code unaltered and on my machine, it took 851 seconds to complete.

Since VBA is optimized for Longs, simply adding one line to your code to declare the variables (a through j) as Longs, brought the running time on my machine down to 120 seconds. So that's seven times faster just for using the appropriate variable type!

My stab at solving this puzzle in VBA runs considerably faster. In fact, it's much faster (and shorter) than anything posted thus far on this page. On my same machine, it returns all 136 correct combinations in less than one second.

There is a lot of nonsense out there (the world, the net, even here on this page!) about VBA being too slow. Don't believe it. Sure, compiled languages can be faster, but much of the time it comes down to how well you know how to handle your language. I've been programming in the BASIC language since the 1970s.

Here is my solution to the Vietnam Puzzle that I crafted for your question. Please place this in a new code module:

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

Method #2:

Anastasiya, I will try to explain it later today, when I have more time. But in the meantime, please examine my next stab at this. It is now even shorter and completes in about 1/10th of a second. I am now using Heap's Permutation Algorithm:

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

Method #3

And here is an even shorter version. Can anyone come up with either a shorter version or a quicker version?

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