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
3. setelah disusun seperti diatas, dan tombol mulai menghitung di klik akan muncul form seperti berikut
Posts
