Gauss Jordan Codigo

Resolución de ecuaciones de n x n, por el método de Gauss-Jordan

• Código:

En el botón Grado de la matriz

Private Sub Boton1_Click()

REspuesta = InputBox("Escriba el grado de la matriz", "Método Gauss-Jordan")

If Val(REspuesta) = 0 Or Val(REspuesta) > 10 Then

    MsgBox "Valor no admitido, intente nuevamente.", vbCritical, "Error"

Else

    Grado = Val(REspuesta)

    Worksheets("Gauss-Jordan").Range("D4") = "Grado: " & Grado

    'Vamos a aparecer todas las cajitas

    NCajas = 1

    For j = 1 To Grado + 1

        For i = NCajas To Grado * j

            Set Caja(i) = ValoresMatriz.Controls.Add("Forms.TextBox.1")

            Caja(i).Width = 40

            Caja(i).Height = 25

            Caja(i).Font.Size = 15

            Caja(i).ForeColor = vbBlack

            Caja(i).BorderStyle = 0

            If i = NCajas Then

                Caja(1).Left = 15

                Caja(1).Top = 15

                If i > 1 Then Caja(i).Top = Caja(1).Top

            Else

                Caja(i).Top = Caja(i).Height + Caja(i - 1).Top

            End If

            If j < Grado + 1 Then

                Caja(i).Left = Caja(1).Left + Caja(1).Width * (j - 1)

            Else

                Caja(i).Left = Caja(1).Left + Caja(1).Width * (j - 1) + 20

            End If

        Next i

        NCajas = NCajas + Grado

    Next j

    ValoresMatriz.Image3.Top = 5

    ValoresMatriz.Image3.Height = Caja(1).Height * Grado + 18

    ValoresMatriz.Image5.Top = 5

    ValoresMatriz.Image5.Height = Caja(1).Height * Grado + 18

    ValoresMatriz.Image5.Left = Caja(1).Width * Grado + 20

    ValoresMatriz.Image4.Top = 5

    ValoresMatriz.Image4.Height = Caja(1).Height * Grado + 18

    ValoresMatriz.Image4.Left = Caja(1).Width * Grado + 85  

    ValoresMatriz.Height = Caja(1).Height * Grado + 80

    ValoresMatriz.Width = Caja(1).Width * Grado + 100

    ValoresMatriz.Calcular.Left = ValoresMatriz.Width - 100

    ValoresMatriz.Calcular.Top = ValoresMatriz.Height - 50

    ValoresMatriz.Show

End If

End Sub

En el botón calcular;

Dim Matriz() As Double

Dim Vti() As Double

Private Sub Calcular_Click()

ReDim Matriz(Grado, Grado + 1)

ReDim Vti(Grado)

For i = 1 To Grado * Grado + Grado

    If Caja(i).Text = "" Then MsgBox "Faltan datos", vbExclamation, "Error": Exit Sub

Next i

For i = 1 To Grado

    For j = 1 To Grado

        Matriz(j, i) = Val(Caja(j + (Grado * (i - 1))).Text)

    Next j

Next i

For i = Grado * Grado + 1 To Grado * Grado + Grado

    Matriz(i - Grado * Grado, Grado + 1) = Val(Caja(i).Text)

    'Vti(i - Grado * Grado) = Val(Caja(i).Text)

Next i

ReDim X(Grado)

Call GAUSSJORDAN(Matriz(), Grado, X())

For i = 1 To Grado

    Range("D" + Trim(Str(6 + i))).Value = "Raíz " & i & "="

    Range("E" + Trim(Str(6 + i))).Value = X(i)

Next i

Unload Me

End Sub

Private Sub UserForm_Click()

End Sub

En el modulo

Global Grado As Integer, i As Integer, j As Integer, NCajas As Integer, X() As Double

Global Caja(1000)

    Sub GAUSSJORDAN(a() As Double, n As Integer, C() As Double)

        Dim Sum As Double

        Dim l As Integer, tem As Double

        m = n + 1

        For l = 1 To n - 1

            j = l

            For k = l + 1 To n

                If (Abs(a(j, l)) >= Abs(a(k, l))) Then

                Else: j = k

...