Mengubah Angka Menjadi Terbilang di Excel

4

19 Juni 2009 oleh fahirohim

Macro Xls

Add-Ins

Forumula Penulisan

Berawal dari tugas kantor yang dituntut cepat dan teliti, pada saat saya menyerahkan hasil kerjaan tersebut terkadang ada saja yang keliru penulisan seperti “seibu maksudnya Seribu” atau “upah seharusnya Rupiah” , sedangkan kekeliruan yang berhubungan dengan angka atau nilai tidak boleh diganti (tipex) walau pakai paraf.

Disaat itu saya mencari aplikasi yang kiranya dapat membantu meringankan kerja, sehingga kerjaan yang menumpuk dapat dikurangi. Akhirnya saya menemukannya pada fasilitas Program Excel, berikut ini langkah-langkah pembuatannya:

* Langkah pertama yaitu bukalah program Microsoft Excel
* Langkah kedua yaitu klik menu Tool, Macro, Security
* Berikutnya pilih Medium atau Low kemudian lalu klik OK dan tutup program Microsoft Excel
* Buka kembali program Microsoft Excel-nya
* Lalu klik menu Tool, Macro, Visual Basic Editor atau bisa langsung tekan tombol Alt+F11
* Setelah muncul jendelanya, klik kanan pada item VBAProject (Book1) yang terdapat pada jendela sebelah kiri
* Maka akan muncul menu, dari menu tersebut pilihlah Insert, Module
* Selanjutnya ketik script di bawah ini pada kotak isian modul tersebut (”Book1 – Module1 (Code)”) atau anda tinggal blok/select lalu copy dan paste pada kotak isian modul dibawah ini :

Option Explicit

‘**********************************
‘ Fungsi Utama
‘ Mengubah Angka Menjadi Teks
‘ Fahirohim
‘ e-mail : Abiserang@yahoo.com
‘ https://fahirohim.wordpress.com
‘ http://geocities.com/abiserang
‘
‘**********************************

Function Terbilang(ByVal MyNumber)
    Dim Rupiah, Sen, Temp
    Dim Des, Desimal, Count, Tmp
    Dim IsNeg

    ReDim Place(9) As String
    Place(2) = “Ribu ”
    Place(3) = “Juta ”
    Place(4) = “Milyar ”
    Place(5) = “Trilyun “

    ‘Ubah angka menjadi string
    MyNumber = Round(MyNumber, 2)
    MyNumber = Trim(Str(MyNumber))
   
    ‘Cek bilangan negatif
    If Mid(MyNumber, 1, 1) = “-” Then
        MyNumber = Right(MyNumber, Len(MyNumber) – 1)
        IsNeg = True
    End If

    ‘Posisi desimal, 0 jika bil. bulat
    Desimal = InStr(MyNumber, “.”)
    ‘Pembulatan sen, dua angka di belakang koma
    Des = Mid(MyNumber, Desimal + 2)
    If Desimal > 0 Then
        Tmp = Left(Mid(MyNumber, Desimal + 1) & “00”, 2)
        If Left(Tmp, 1) = “0” Then
            Tmp = Mid(Tmp, 2)
            Sen = Satuan(Tmp)
        Else
            Sen = Puluhan(Tmp)
        End If
        MyNumber = Trim(Left(MyNumber, Desimal – 1))
    End If

    Count = 1
    Do While MyNumber <> “”
       Temp = Ratusan(Right(MyNumber, 3), Count)
       If Temp <> “” Then Rupiah = Temp & Place(Count) & Rupiah
          If Len(MyNumber) > 3 Then
             MyNumber = Left(MyNumber, Len(MyNumber) – 3)
       Else
          MyNumber = “”
       End If
       Count = Count + 1
    Loop

    Select Case Rupiah
        Case “”
            Rupiah = “nol rupiah”
        Case Else
            Rupiah = Rupiah & “Rupiah”
    End Select

    Select Case Sen
        Case “”
            Sen = “”
        Case Else
            Sen = ” dan ” & Sen & “sen”
    End Select

    If IsNeg = True Then
        Terbilang = “minus ” & Rupiah & Sen
    Else
        Terbilang = Rupiah & Sen
    End If

End Function
‘**************************************
‘ Mengubah angka 100-999 menjadi teks *
‘**************************************
Function Ratusan(ByVal MyNumber, Count)
    Dim Result As String
    Dim Tmp

    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right(“000” & MyNumber, 3)

    ‘Mengubah seribu
    If MyNumber = “001” And Count = 2 Then
        Ratusan = “se”
        Exit Function
    End If

    ‘Mengubah ratusan
    If Mid(MyNumber, 1, 1) <> “0” Then
        If Mid(MyNumber, 1, 1) = “1” Then
            Result = “Seratus ”
        Else
            Result = Satuan(Mid(MyNumber, 1, 1)) & “Ratus ”
        End If
    End If

    ‘Mengubah puluhan dan satuan
    If Mid(MyNumber, 2, 1) <> “0” Then
        Result = Result & Puluhan(Mid(MyNumber, 2))
    Else
        Result = Result & Satuan(Mid(MyNumber, 3))
    End If

    Ratusan = Result

End Function
‘*******************
‘ Mengubah puluhan *
‘*******************
Function Puluhan(TeksPuluhan)
    Dim Result As String

    Result = “”
    ‘ nilai antara 10-19
    If Val(Left(TeksPuluhan, 1)) = 1 Then
        Select Case Val(TeksPuluhan)
            Case 10: Result = “Sepuluh ”
            Case 11: Result = “Sebelas ”
            Case Else
                Result = Satuan(Mid(TeksPuluhan, 2)) & “Belas ”
        End Select
    ‘ nilai antara 20-99
    Else
        Result = Satuan(Mid(TeksPuluhan, 1, 1)) _
                 & “Puluh ”
        Result = Result & Satuan(Right(TeksPuluhan, 1))
   ‘satuan
    End If
        Puluhan = Result
    End Function
‘********************************
‘ Mengubah satuan menjadi teks. *
‘********************************
Function Satuan(Digit)
    Select Case Val(Digit)
        Case 1: Satuan = “Satu ”
        Case 2: Satuan = “Dua ”
        Case 3: Satuan = “Tiga ”
        Case 4: Satuan = “Empat ”
        Case 5: Satuan = “Lima ”
        Case 6: Satuan = “Enam ”
        Case 7: Satuan = “Tujuh ”
        Case 8: Satuan = “Delapan ”
        Case 9: Satuan = “Sembilan ”
        Case Else: Satuan = “”
    End Select
End Function

Setelah script di atas diketik atau copy/paste, lalu simpan file lembar kerja Excel tersebut dengan nama file “TERBILANG.XLS”. Maka sudah siap deh lembar kerja tersebut dipakai. Cara menggunakannya tinggal anda ketik fungsinya yaitu =terbilang. Sebagai contoh coba anda isikan Rp. 7.654.321,- pada sel A1, lalu pada sel B1 tuliskan “=TERBILANG(A1)” maka setelah anda menekan enter akan muncul tulisan “TUJUH JUTA ENAM RATUS LIMA PULUH EMPAT RIBU TIGA RATUS DUA PULUH SATU RUPIAH” pada sel B1.

Mudah bukan? Langkah di atas sudah saya coba dan berhasil, kalau masih tidak muncul atau muncul pesan kesalahan error berarti macro masih belum benar, coba periksa kembali langkah-langkahnya atau biasanya kesalahan terjadi pada tanda kutip, coba rubah/ganti secara manual tanda kutipnya.

Selamat mencoba semoga bermanfaat.