Waktu ada temen yang nanyain cara nampilin nominal di excel, aku jadi penasaran gimana cara bikinnya. aku coba browsing dan nemuin artikelnya di http://aurino.com/wordpress/?p=8. Disini aku tambahkan kode agar dapat membaca angka minus.
Berikut cara membuat fungsi Terbilang pada macro excel :
Masukkan Kode dalam listing vba function dengan cara mengcopy seluruh kode
ke dalam module Vba dalam suatu worksheet.
1. Pilih Tool – Macro – Visual Basic Editor atau Alt-F11
2. Insert – Module
3. Copy kode macro berikut ini
'******************************************************************'
Public Function terbilang(y 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
x = y
If x > 1E+15 Then
terbilang = ""
Exit Function
End If
'R.A :)
'cek bilangan negatif
If Left(x, 1) = "-" Then
x = Mid(x, 2, 100)
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,milyar,dll
triliun = Int(x / 1000 ^ 4)
milyar = Int((x - triliun * 1000 ^ 4) / 1000 ^ 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 bag triliun + ditambah akhiran triliun
If triliun > 0 Then
baca = ratus(triliun, 5) + "triliun "
End If
'baca bag milyar + ditambah akhiran milyar
If milyar > 0 Then
baca = baca + ratus(milyar, 4) + "milyar "
End If
'baca bag juta + ditambah akhiran juta
If juta > 0 Then
baca = baca + ratus(juta, 3) + "juta "
End If
'baca bag ribu + ditambah akhiran ribu
If ribu > 0 Then
baca = baca + ratus(ribu, 2) + "ribu "
End If
'baca bag satuan + ditambah akhiran satuan
If satu > 0 Then
baca = baca + ratus(satu, 1)
End If
'baca bag sen + ditambah akhiran sen
If sen > 0 Then
baca = baca + "rupiah " + ratus(sen, 0) + "sen "
Else
baca = baca + "rupiah "
End If
End If
'jika bilangan negatif
If Left(y, 1) = "-" Then
terbilang = "# Minus " + UCase(Left(baca, 1)) & LCase(Mid(baca, 2)) + "#"
Else
'jika bilangan positif
terbilang = "# " + UCase(Left(baca, 1)) & LCase(Mid(baca, 2)) + "#"
End If
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)
'baca bag ratus
If a100 = 1 Then
baca = "Seratus "
Else
If a100 > 0 Then
baca = angka(a100, 2) + "ratus "
End If
End If
'baca bag puluh + satuan
If a10 = 1 Then
baca = baca + angka(a10 * 10 + a1, 2)
Else
If a10 > 0 Then
baca = baca + angka(a10, 2) + "puluh "
End If
If a1 > 0 Then
If posisi = 2 And a100 = 0 And a10 = 0 Then
baca = baca + angka(a1, 1)
Else
baca = baca + angka(a1, 2)
End If
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 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 = "Dua belas "
Case 13: angka = "Tiga belas "
Case 14: angka = "Empat belas "
Case 15: angka = "Lima belas "
Case 16: angka = "Enam belas "
Case 17: angka = "Tujuh belas "
Case 18: angka = "Delapan belas "
Case 19: angka = "Sembilan belas "
End Select
End Function
'******************************************************************'
4. klik File Save dan selesai.
untuk mencobanya silahkan kembali ke tampilan microsoft excel atau tekan alt+F11
lalu masukan nominal dan formula =terbilang()
contoh:
