Penyelesaian persamaan simultan : alogaritma dan pemrograman visual basic (VBA) dan excel

persamaan simultan yang terdiri dari n persamaan dengan jumlah n yang tidak diketahui dapat diselesaikan dengan metode gaus jordan, untuk mempermudah digunakan prinsip matrik
Design form

seperti konsep sebelumnya untuk menampilkan form ini saya masukkan command button ke dalam excel langsung, seperti dibawah berikut, caranya aktifkan tabs developer lalu klik design mode, lalu insert command button, hasilnya seperti dibawah berikut

pada button tersebut masukkan perintah seperti berikut

Private Sub btn_Run_Gauss_Jordan_Click()

    frm_M_GaussJordan.Show

End Sub

perintah tersebut akan menampilkan form gausjordan (tergantung anda menamainya seperti apa)
Pembuatan Program
1. pemakaian input
untuk memakai input saya memakai reference edit box, atau namanya refedit, tool ini hanya ada di VBA, penggunaanya adalah untuk menselect range(cell, cell) pada visual basic, untuk menghitung matrik, metode ini sangat efisien

cara memakainya tinggal masukkan ke form, dari toolbox, pilih refedit (pojok kiri bawah pada gambar diatas) hasilnya seperti pada box setelah masukkan matrix x...
2. membuat module program
membuat modul fungsi yang bisa dipanggil sudah saya jelaskan di beberapa posting sebelumnya, tentang bisection dan newton rapshon,
isi dari module tersebut kira-kira seperti ini, kata garis miring adalah keteranganya, biar mudah dipahami sesuai dengan permintaan sohib-sohib sekelas


Function Gauss_Jordan(A As Variant) As Variant
Dim i As Long, j As Long, k As Long, Atemp
Dim cols As Long, rows As Long, MaxVal As Double
Dim Max_Ind As Double, temp As Double, hold()


    'bila fungsi mulai dipanggil, jumlah kolom dan baris akan dihitung untuk menentukan jumlah n, dan apakah matrix yang ada dapat dihitung, object(A) maksudnya adalah matrix untuk X, = trus artinya bila ada nilainya
   
  If IsObject(A) = True Then
        cols = A.Columns.Count
        rows = A.rows.Count
    Else
        cols = UBound(A, 2)
        rows = UBound(A, 1)
    End If
    
    'menambahkan kolom untuk meletakkan hasil perhitungan,  Atemp merupakan matrix temporary sebelum digunakan nantinya dalam perhitungan.


    cols = cols + cols
    ReDim hold(1 To rows, 1 To cols), Atemp(1 To rows, 1 To cols)
    
    'menambahkan matrix x dan matrix y menjadi augmented matrix, aug matrix adalah matrix gabungan antara x dan y


    For i = 1 To rows
        For j = 1 To rows
            Atemp(i, j) = A(i, j)
            Atemp(i, j + rows) = 0#
        Next j
        Atemp(i, i + rows) = 1#
    Next i
    
    For i = 1 To rows
    
        MaxVal = Atemp(i, i)
        Max_Ind = i
       
 ' prosedure pendek menghitung nilai maximum, hal ini berguna untuk menentukan apakah matirx tersebut ada penyelesaianya atau tidak, akan muncul msg box error bila matrix ternyata singular


        For j = i + 1 To rows
            If Abs(Atemp(j, i)) > Abs(MaxVal) Then
                MaxVal = Atemp(j, i)
                Max_Ind = j
            End If
        Next j
        
        If MaxVal = 0 Then
            MsgBox Prompt:="Matrix adalah singular!", Title:="Error"
            Exit Function
        End If
        
        'prosedure perhitungan pivoting pada matrix


        For j = i To cols
            temp = Atemp(i, j)
                    Atemp(i, j) = Atemp(Max_Ind, j) / MaxVal
                      If Max_Ind <> i Then Atemp(Max_Ind, j) = temp
        Next j
        
        
        For k = 1 To rows
            If k <> i Then            
              
                For j = 1 To cols
                    hold(k, j) = -Atemp(k, i) * Atemp(i, j)
                Next j
             
                For j = 1 To cols
                   Atemp(k, j) = Atemp(k, j) + hold(k, j)
                Next j
            End If
        Next k
    Next i
    Gauss_Jordan = Atemp
End Function

------------------------------------------------------------------------
wahh.. panjang dan ribet? betul sekali, kok bisa bikin program seperti itu? nanti saya tunjukin rahasianya, sekarang kita teruskan membuat programnya

3. program pada button Hitung
double klik tombol hitung lalu masukkan perintah seperti berikut


Private Sub OK_Btn_Click()


Dim i As Double, j As Double, Data As Variant, n As Double
Dim A As Variant, MaxCol As Double, temp As Double, b()
Dim wks, cntsheets, newsheet As Worksheet, FinalCol As Double
Dim x(), Aplus(), Ainv()

' untuk menjaga agar inputan tidak salah, gunakan coding berikut ini, bila input matrix salah, atau ada huruf yang dimasukkan ke dalam cell, maka akan muncul peringatan kalau input matrix salah


If IP_A.Value = Empty Then
        Me.Hide
        MsgBox Prompt:="Pilih Cell untuk memasukkan angka." & vbCr & _
                       "Jangan tulis dengan variablenya.", _
                       Buttons:=48, Title:="Matrix input salah!"
        Me.Show
        Exit Sub
    End If

' matrix A adalah matrix input pada x


A = Application.RANGE(IP_A.Value)
 n = UBound(A, 1)

' pengecekan matrix untuk Y atau B pada program berikut


If IP_b.Value <> Empty Then
        b = Application.RANGE(IP_b.Value)
        If UBound(A, 1) <> UBound(b, 1) Then
            Me.Hide
            MsgBox Prompt:="baris di A harus sama dengan baris di b.", _
                   Buttons:=544, Title:="Error!"

     Err.Description = "Jumlah Baris Matrix tidak sama."
            GoTo EndProc
        End If
    End If

' terakhir menghitung inverse yang dilanjutkan untuk menghitung adjoint matrix, sehingga didapatkan nilai x1-xn

Aplus = Gauss_Jordan(A)
        If IsError(Aplus) Then GoTo EndProc
        ReDim Ainv(1 To n, 1 To n)
    For i = 1 To n
        For j = 1 To n
            Ainv(i, j) = Aplus(i, j + n)
        Next j
    Next i

If IP_b.Value <> Empty Then
        x = Application.MMult(Ainv, b)
    End If

' hasilnya diletakkan pada sheet baru


   cntsheets = Application.Sheets.Count - Application.Charts.Count
        Set newsheet = Application.Worksheets.add(after:=Worksheets(cntsheets))
        newsheet.name = "Hasil X!"
        FinalCol = 0


With Application
          .Cells(1, FinalCol + 1) = "Inverse Matrix "
        For j = 1 To n
           For i = 1 To n
               .Cells(i + 1, FinalCol + j).Value = Ainv(i, j)
           Next i
        Next j
        If IP_b.Value <> Empty Then
            FinalCol = FinalCol + n
            Cells(1, FinalCol + 1) = "SOLUSI"
            For i = 1 To n
                .Cells(i + 1, FinalCol + 1).Value = x(i, 1)
            Next i
        End If
    End With
    
    Application.Calculation = xlCalculationAutomatic


Unload Me
Exit Sub

-----------------
 program ini diambil dari beberapa sumber, ada tiga buku yang dipakai, satu buku berhasil saya download sedangkan dua buku lainya masih nongkrong di google book, silahkan check di refferensi bawah.

karena posting ini panjang, maka hasil programnya saya pisah, silahkan check dibawah ini, untuk mengetahui hasilnya, hasilnya dapat dilihat disini

Referensi Wajib

1.   Excel scientific and engineering cookbook  By David M. Bourg
2.   Numerical Methods with VBA Programming  By James Hiestand
3.   Excel for Scientists and Engineers: Numerical Methods   E. Joseph Billo 

Posted in: Gauss Jordan, komputasi teknik, persamaan simultan