Fungsi Terbilang – Merubah bilangan ke kata
Fungsi Terbilang(...) dan TerbilangRp(...) Pada worksheet ini kita memakai fungsi terbilang yang telah di entry pada module Terbilang Pada module tersebut kita memiliki dua fungsi utama untuk menampilkan angka menjadi: 1. Terbilang(x) -> sekian koma sekian per seratus 2. TerbilangRp(x) -> sekian rupiah sekian sen Penggunaannya sama dengan penggunaan fungsi-fungsi dalam excel lainnya. Contoh 922,337,203,685,477.00 (angka tertinggi yang bisa diterjemahkan) Ditulis : Sembilan ratus dua puluh dua triliun tiga ratus tiga puluh tujuh milyar dua ratus tiga juta enam ratus delapan puluh lima ribu empat ratus tujuh puluh tujuh = TerbilangRp(B9) Hasilnya: Sembilan ratus dua puluh dua triliun tiga ratus tiga puluh tujuh milyar dua ratus tiga juta enam ratus delapan puluh lima ribu empat ratus tujuh puluh tujuh koma aurinoradjamari@yahoo.com aurino@telkom.net 'This Public Function for Indonesian "Numeric to string Converstion" 'You can copy, modify or take part of this function 'Redesign and retouch to get new rupiah function by: aurinoradjamaris@yahoo.com Public Function Terbilang(x As Currency) Dim triliun As Currency Dim milyar As Currency Dim juta As Currency Dim ribu As Currency Dim satu As Currency Dim sen As Currency Dim baca As String If x > 1E+15 Then Terbilang = "<di atas satu triliun rupiah>" Exit Function End If 'jika x adalan 0, maka dibaca sebagai 0 If x = 0 Then baca = angka(0, 1) Else 'Pisah masing-masing bagian untuk triliun, milyard, juta, ribu, rupiah dan sen triliun = Int(x * 0.001 ^ 4) milyar = Int((x - triliun * 1000 ^ 4) * 0.001 ^ 3) juta = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3) * 0.001 ^ 2) ribu = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2) * 0.001) satu = Int(x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2 - ribu * 1000) sen = Int((x - Int(x)) * 100) 'baca bagian triliun dan ditambah akhiran trilliun If triliun > 0 Then baca = Ratus(triliun, 5) + "triliun " End If 'baca bagian milyar dan ditambah akhiran milyar If milyar > 0 Then baca = baca + Ratus(milyar, 4) + "milyar " End If 'baca bagian juta dan ditambah akhiran juta If juta > 0 Then baca = baca + Ratus(juta, 3) + "juta " End If 'baca bagian ribu dan ditambah akhiran ribu If ribu > 0 Then baca = baca + Ratus(ribu, 2) + "ribu " End If 'baca bagian rupiah dan ditambah akhiran rupiah If satu > 0 Then baca = baca + Ratus(satu, 1) End If 'baca bagian sen dan ditambah akhiran sen If sen > 0 Then baca = baca + "koma " + Ratus(sen, 0) + "per seratus " End If End If Terbilang = UCase(Left(baca, 1)) & LCase(Mid(baca, 2)) End Function Public Function TerbilangRp(x As Currency) Dim triliun As Currency Dim milyar As Currency Dim juta As Currency Dim ribu As Currency Dim satu As Currency Dim sen As Currency Dim baca As String If x > 1E+15 Then TerbilangRp = "<di atas seribu triliun rupiah>" Exit Function End If 'jika x adalah 0, maka dibaca sebagai 0 If x = 0 Then baca = angka(0, 1) Else 'Pisah masing-masing bagian untuk triliun, milyard, juta, ribu, rupiah dan sen triliun = Int(x / 1000 ^ 4) milyar = Int((x - triliun * 1000 ^ 4) * 0.001 ^ 3) juta = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3) / 1000 ^ 2) ribu = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2) / 1000) satu = Int(x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2 - ribu * 1000) sen = Int((x - Int(x)) * 100) 'baca bagian triliun dan ditambah akhiran trilliun If triliun > 0 Then baca = Ratus(triliun, 5) + "triliun " End If 'baca bagian milyar dan ditambah akhiran milyar If milyar > 0 Then baca = baca + Ratus(milyar, 4) + "milyar " End If 'baca bagian juta dan ditambah akhiran juta If juta > 0 Then baca = baca + Ratus(juta, 3) + "juta " End If 'baca bagian ribu dan ditambah akhiran ribu If ribu > 0 Then baca = baca + Ratus(ribu, 2) + "ribu " End If 'baca bagian rupiah dan ditambah akhiran rupiah If satu > 0 Then baca = baca + Ratus(satu, 1) + "" End If 'sebelum bagian sen baca = baca & "rupiah " 'baca bagian sen dan ditambah akhiran sen If sen > 0 Then baca = baca + Ratus(sen, 0) + "sen " End If End If TerbilangRp = UCase(Left(baca, 1)) & LCase(Mid(baca, 2)) End Function Function Ratus(x As Currency, Posisi As Integer) As String Dim a100 As Integer, a10 As Integer, a1 As Integer Dim baca As String a100 = Int(x * 0.01) a10 = Int((x - a100 * 100) * 0.1) a1 = Int(x - a100 * 100 - a10 * 10) If a100 = 1 Then baca = "Seratus " Else If a100 > 0 Then baca = angka(a100, Posisi) + "ratus " End If End If 'baca bagian puluhan dan satuan If a10 = 1 Then baca = baca + angka(a10 * 10 + a1, Posisi) Else If a10 > 0 Then baca = baca + angka(a10, Posisi) + "puluh " End If If a1 > 0 Then baca = baca + angka(a1, Posisi) End If End If Ratus = baca End Function Function angka(x As Integer, Posisi As Integer) Select Case x Case 0: angka = "Nol" Case 1: If Posisi <= 2 Or Posisi > 2 Then angka = "Satu " Else angka = "Se" End If Case 2: angka = "Dua " Case 3: angka = "Tiga " Case 4: angka = "Empat " Case 5: angka = "Lima " Case 6: angka = "Enam " Case 7: angka = "Tujuh " Case 8: angka = "Delapan " Case 9: angka = "Sembilan " Case 10: angka = "Sepuluh " Case 11: angka = "Sebelas " Case 12: angka = "Duabelas " Case 13: angka = "Tigabelas " Case 14: angka = "Empatbelas " Case 15: angka = "Limabelas " Case 16: angka = "Enambelas " Case 17: angka = "Tujuhbelas " Case 18: angka = "Delapanbelas " Case 19: angka = "Sembilanbelas " End Select End Function Memasukkan Fungsi Terbilang Masukkan Kode dalam listing vba function dengan cara mengcopy seluruh kode ke dalam module Vba dalam suatu worksheet. 1. Blok/sorot A1:A163 dan Copy atau Ctrl-C pada Sheet Listing Vba Function 2. Pilih Tool - Macro - Visual Basic Editor atau Alt-F11 3. Insert - Module 4. Edit - Paste atau Ctrl-V 5 File Save … Beri nama misalnya: BacaAngka atau yang lainnya selesai anda tinggal menggunakannya.