About the Author

' Writes algorithm after further deduction

' Tested with Office 2007 under Windows 7

Sub Rewite1()

    Dim a(14, 37)

y = MsgBox("Locked", vbCritical, "Routine Rewite1")
End

    Sheets("Matrix6a").Select

    n10 = 1691                               'n10 = (Startline - 1)

    k10 = 13: k20 = 37
    For j1 = 1 To k10
        For j2 = 1 To k20
            a(j1, j2) = Cells(n10 + j1, j2).Value
        Next j2
    Next j1
    
    GoSub 700                                'Writes algorithm
    
    Close #1
    
    End
    
'   Schrijf algoritme

700 Open "C:\Users\jos\WebSite\Entertainment\Descriptions\Excel\Vierkanten\alg.txt" For Output As #1
    Print #1, "'": Print #1, "' bepaal mogelijke oplossingen": Print #1, "'"
    For j10 = k10 To 1 Step -1
    fl = 0
    For j20 = 1 To k20
        If a(j10, j20) <> 0 Then fl = 1: j30 = j20: GoTo 702  'te bepalen variabele
    Next j20
702 If fl = 0 Then GoTo 710
       prstr1$ = "a(" + Str$(j30) + ")="
       s1 = a(j10, k20)
       If s1 <> 0 Then
          If Abs(s1) <> 1 Then
            prstr1$ = prstr1$ + Str$(s1) + "*s1"
          ElseIf s1 > 0 Then
            prstr1$ = prstr1$ + "s1"
          ElseIf s1 < 0 Then
            prstr1$ = prstr1$ + "-s1"
          End If
       End If
    For j20 = j30 + 1 To k20 - 1
       a1 = a(j10, j20)
       If a1 <> 0 Then
          a10$ = Str$(a1)
          If a1 > 0 Then
            prstr1$ = prstr1$ + "-"
          Else
            prstr1$ = prstr1$ + "+": a10$ = Mid$(a10$, 2)
          End If
          If Abs(a1) <> 1 Then
            prstr1$ = prstr1$ + a10$ + "*a(" + Str$(j20) + ")"
          Else
            prstr1$ = prstr1$ + "a(" + Str$(j20) + ")"
          End If
       End If
705 Next j20
    Print #1, prstr1$
710 Next j10
    Print #1, "RETURN"
    Return

End Sub

About the Author