Sabtu, 30 Mei 2009

VBA-Excel : Fungsi Angka Dari Suatu Kalimat Terbilang

Bermula dari sebuah pertanyaan :
bagaimana jika sebaliknya???
dari "Lima milyar tiga ratus empat puluh enam juta lima ratus tiga belas ribu seratus dua puluh tiga rupiah" menjadi "5.346.513.123"


Maka berikut ini saya mencoba membuat sebuah fungsi yang disebut sebagai fungsi bilangan. Fungsi tersebut berguna untuk mendapatkan angka dari sebuah kalimat terbilang sebagaimana pertanyaan di atas.

Fungsi bilangan tersebut merupakan kebalikan dari fungsi terbilang dimana fungsi terbilang berguna untuk menerjemahkan kumpulan angka menjadi kalimat terbilang dari suatu kumpulan angka tersebut.

Berikut ini adalah kode yang harus anda buat pada aplikasi VBA excel sebagai macro :


Function bilangan(xx)
'///////////////////////////////////////////////////////////////////////////////////
'kode oleh mas_djoko aka xantov (xantov@gmail.com)
'kode ini mungkin masih terdapat bug, silahkan disempurnakan lagi
'jika hendak menyebarkan fungsi ini harap tidak menghapus komentar ini
'///////////////////////////////////////////////////////////////////////////////////
On Error Resume Next

Dim x
Dim ak, od1, od2, od3, od4, od5
Dim tOrde
Dim Arr
Dim nArr
Dim Terbilang

Terbilang = LCase(Replace(xx, " belas", "belas"))
Terbilang = Replace(Terbilang, "milyar", "miliar")
Terbilang = Replace(Terbilang, "rupiah", "")
Terbilang = Replace(Terbilang, "dollar", "")
Terbilang = Replace(Terbilang, "sebelas", "satu puluh satu")
Terbilang = Replace(Terbilang, "duabelas", "satu puluh dua")
Terbilang = Replace(Terbilang, "tigabelas", "satu puluh tiga")
Terbilang = Replace(Terbilang, "empatbelas", "satu puluh empat")
Terbilang = Replace(Terbilang, "limabelas", "satu puluh lima")
Terbilang = Replace(Terbilang, "enambelas", "satu puluh enam")
Terbilang = Replace(Terbilang, "tujuhbelas", "satu puluh tujuh")
Terbilang = Replace(Terbilang, "delapanbelas", "satu puluh delapan")
Terbilang = Replace(Terbilang, "sembilanbelas", "satu puluh sembilan")
Terbilang = Replace(Terbilang, "sepuluh", "satu puluh")
Terbilang = Replace(Terbilang, "seratus", "satu ratus")
Terbilang = Replace(Terbilang, "seribu", "satu ribu")

Arr = Split(Terbilang)

nArr = UBound(Arr) - LBound(Arr) + 1

For x = 0 To nArr + 1
ak = 0: od1 = 1: od2 = 1: od3 = 1: od4 = 1: od5 = 1: tOrde = 1

od1 = xbaca(Arr(x + 1), "orde")
od2 = xbaca(Arr(x + 2), "orde")
od3 = xbaca(Arr(x + 3), "orde")
od4 = xbaca(Arr(x + 4), "orde")
od5 = xbaca(Arr(x + 5), "orde")
ak = xbaca(Arr(x), "angka")


If od5 > od4 And od5 > od3 And od5 > od2 And od5 > od1 Then
tOrde = od1 * od5
ElseIf od4 > od3 And od4 > od2 And od4 > od1 Then
tOrde = od1 * od4
ElseIf od3 > od2 And od3 > od1 And od3 > od5 Then
tOrde = od3 * od1
ElseIf od2 > od1 Then
tOrde = od2 * od1
ElseIf od1 > od2 And od1 > od3 And od1 > od5 Then
tOrde = od1
End If

bilangan = bilangan + (ak * tOrde)

Next

End Function

Function xbaca(bilang, pilih)
Dim angka, orde
Select Case bilang
Case "satu": angka = 1: orde = 1
Case "dua": angka = 2: orde = 1
Case "tiga": angka = 3: orde = 1
Case "empat": angka = 4: orde = 1
Case "lima": angka = 5: orde = 1
Case "enam": angka = 6: orde = 1
Case "tujuh": angka = 7: orde = 1
Case "delapan": angka = 8: orde = 1
Case "sembilan": angka = 9: orde = 1
Case "puluh": orde = 10: angka = 0
Case "ratus": orde = 100: angka = 0
Case "ribu": orde = 1000: angka = 0
Case "juta": orde = 1000000: angka = 0
Case "miliar": orde = 1000000000: angka = 0
Case "triliun": orde = 1000000000000#: angka = 0
Case "": orde = 1: angka = 0
End Select

Select Case pilih
Case "orde"
xbaca = orde
Case "angka"
xbaca = angka
End Select

End Function


Setelah selesai membuat fungsi tersebut, maka untuk menggunakannya anda cukup mengetikkan :
=bilangan(sel_target) pada worksheet excel

Tidak ada komentar: