Fungsi Terbilang tanpa hurup rupiah dibelakangnya

Fungsi terbilang berfungsi untuk mengotomatiskan angka menjadi bilangan, sehingga kita tidak perlu lagi menulisnya lagi. Kita hanya memberi perintah maka akan secara otomatis berubah.

Untuk fungsi terbilang ini, saya mempunyai 2 fungsi, yaitu bilangan yang menampilkan hurup rupiah dibelakangnya dan yang satunya lagi tidak menampilkannya.

Hal ini sebetulnya tergantung dari kebutuhan anda, dan untuk kali ini saya akan memberikan contoh fungsi terbilang yang tidak menampilkan hurup rupiah.

Pada Cells F2 anda tuliskan =terbilang1(B2)

Silahkan anda coba rubah angka yang diberi warna kuning dan lihat hasilnya di sell F2

Cara Membuat Fungsi Terbilang tanpa hurup rupiah dibelakangnya

• Masuk ke Microsoft Visual Basic for Applications window dengan menekan tombol Alt + F11 atau anda klik tab "Developer" lalu klik "Visual Basic". Apabila di Office anda belum tampil tab Developer, silahkan baca "Cara Menampilkan Ribbon Developer"


• Klik Insert kemudian klik Module


• Copy Paste kode berikut di bawah ini dan masukan ke dalam module


Kode VBA Excel untuk Fungsi Terbilang tanpa hurup rupiah dibelakangnya

'https://baladaka.blogspot.com
'============================

Public Function Terbilang(a 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 a > 1000000000000# Then
       Terbilang = "< Silahkan input nilai dibawah satu triliun rupiah >"
       Exit Function
    End If
    'Jika a = 0, maka dibaca 0
    If a = 0 Then
       baca = angka(0, 1)
    Else
       'bilangan triliun, milyar, juta, ribu, rupiah, dan sen
       triliun = Int(a * 0.001 ^ 4)
       milyar = Int((a - triliun * 1000 ^ 4) * 0.001 ^ 3)
       juta = Int((a - triliun * 1000 ^ 4 - milyar * 1000 ^ 3) / 1000 ^ 2)
       ribu = Int((a - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2) / 1000)
       satu = Int(a - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2 - ribu * 1000)
       Sen = Int((a - Int(a)) * 100)
       'membuat bilangan triliun
       If triliun > 0 Then
          baca = ratus(triliun, 5) + "triliun "
       End If
       'membuat bilangan milyar
       If milyar > 0 Then
          baca = ratus(milyar, 4) + "milyar "
       End If
       'membuat bilangan juta
       If juta > 0 Then
          baca = baca + ratus(juta, 3) + "juta "
       End If
       'membuat bilangan ribu
       If ribu > 0 Then
          baca = baca + ratus(ribu, 2) + "ribu "
       End If
       'membuat bilangan rupiah
       If satu > 0 Then
          baca = baca + ratus(satu, 1) + ""
       Else
          baca = baca + ""
       End If
       'membuat bilangan sen
       If Sen > 0 Then
          baca = baca + ratus(Sen, 0) + "sen "
       End If
    End If
    Terbilang = UCase(Left(baca, 1)) & LCase(Mid(baca, 2))
End Function

Function ratus(a As Currency, Posisi As Integer) As String
    Dim a100 As Integer, a10 As Integer, a1 As Integer
    Dim baca As String
    a100 = Int(a * 0.01)
    a10 = Int((a - a100 * 100) * 0.1)
    a1 = Int(a - a100 * 100 - a10 * 10)
    'Spesifikasi Ratus
    If a100 = 1 Then
       baca = "Seratus "
    Else
       If a100 > 0 Then
          baca = angka(a100, Posisi) + "ratus "
       End If
    End If
    'Spesifikasi 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(a As Integer, Posisi As Integer)
    Select Case a
        Case 0: angka = "Nol"
        Case 1:
            If Posisi <= 1 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 = "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



• Simpan file tersebut ke dalam type atau Save as type : Excel Macro-Enabled Workbook atau type Excel Binary Workbook

Contoh file VBA Excel "Fungsi Terbilang Tanpa rupiah"

Download