Senin, 03 November 2008

EXCEL USER DEFINED FUNCTION

Dalam Microsoft Excel terdapat banyak Function-function, ada tentang Finance IRR (internal rate of return), Fungsi Matematika spt : LOG, LN, COS dll, masalahnya kalau kita tidak puas dengan Built in Function yang standard, berarti kita harus buat function sendiri, misalnya kalau anda mau bikin function Terbilang, yang fungsinya mengeja angka satu per satu contoh :
anda masukkan 12350 hasilnya menjadi dua belas ribu tiga ratus lima puluh
(capek lho ngetik satu-satu, apalagi yang kerjaannya bikin kwitansi / spk / RAB.. )

cara bikin function : pake Visual Basic
Tools - Macro - Visual Basic Editor

trus bikin program nya, list nya kurang lebih begini :

Public Duta(1 To 9), sat(0 To 3) As String
Dim say, Pc, Psat, B, Cs As String
Dim P, S, c, Belasan, D, U, T, A, W, Code As Integer

Function BacaRupiah(WIJAYANTO As String) As String
Call Siapin
say = ""
Pc = ""
P = Len(WIJAYANTO)
S = P Mod 3

If (P <= 3 And P >= 0) Then A = 1
If (P <= 6 And P > 3) Then A = 2
If (P <= 9 And P > 6) Then A = 3
If (P <= 12 And P > 9) Then A = 4
If P > 12 Then A = 0


If S = 1 Then
WIJAYANTO = "00" + WIJAYANTO
Else:
If S = 2 Then
WIJAYANTO = "0" + WIJAYANTO
End If
End If

For W = 1 To A

T = A - W
B = Right(Left(WIJAYANTO, W * 3), 3)
Belasan = 0
D = 0
For U = 1 To 3

Cs = Mid(B, U, 1)
c = Val(Cs)
If c = 0 Then D = D + 1
Select Case U
Case 1
Pc = ratus(CInt(c))
Case 2
Pc = puluh(CInt(c))
Case 3
Pc = satuan(CInt(c))
End Select
say = say + Pc
Psat = Psat + Pc
Pc = ""
Next U

If Psat = "" Then
say = say
Else
say = say + sat(T)
End If
Psat = ""
Next W
BacaRupiah = say
End Function

Private Sub Siapin()
Duta(1) = "satu "
Duta(2) = "dua "
Duta(3) = "tiga "
Duta(4) = "empat "
Duta(5) = "lima "
Duta(6) = "enam "
Duta(7) = "tujuh "
Duta(8) = "delapan "
Duta(9) = "sembilan "
sat(0) = ""
sat(1) = "ribu "
sat(2) = "juta "
sat(3) = "milyard "
End Sub

Private Function ratus(c As Integer) As String



If Not (c = 0) Then
If (c = 1) Then
Pc = "se"
Else:
Pc = Duta(c)
End If
Pc = Pc + "ratus "
End If
ratus = Pc
End Function


Private Function puluh(c As Integer) As String


If Not (c = 0) Then

If (c = 1) Then
Belasan = 1
Else:
Pc = Duta(c) + "puluh "
End If

End If
puluh = Pc
End Function

Private Function satuan(c As Integer) As String

If Not ((Belasan = 0) And (c = 0)) Then

If (Belasan = 1) Then
Select Case c
Case 1
Pc = "sebelas "
Case 0
Pc = "sepuluh "
Case Else
Pc = Duta(c) + "belas "
End Select
Else:
If ((D = 2 And T = 1) And c = 1) Then
Pc = "se"
Else:
Pc = Duta(c)
End If
End If
End If
satuan = Pc
End Function

atau kalau ngga mau puyeng, download aja yg udah jadi nya :

Download Terbilang.xls disini !!

INTEGRASI NUMERIC
bikin function pakai ms excel buat menghitung integral numerik dengan metode trapezoidal dan 3/8 simpson, numerical integration with excel user defined function, UDF excel to calculating integral, download here free source code, gratis :

http://www.4shared.com/dir/7578368/a424e0ac/sharing.html


SOLUSI TERHADAP "page to repeat at bottom" yang tidak disediakan MS EXCEL,

kalau mau bikin garis border bawah di tiap halaman ms excel caranya :
pakai makro di bawah ini :

Sub Macro1()
Dim StrFtr As String
StrFtr = Range("O1") & vbLf & Range("O2") & vbLf & Range("O3")
ActiveSheet.PageSetup.LeftFooter = StrFtr
End Sub

terus isi di sel O1 atau O2 atau O3 (bisa salah satu atau ketiganya), isi dengan garis
under score yg banyak : ________________________________________________________________________________________

terus makro nya di - run, setting di print preview, selamat mencoba

Tidak ada komentar: