Rumus Terbilang di Excel

Sebuah aplikasi excel bisa membuat sesuatu pekerjaan menjadi lebih mudah. Untuk membuat sebuah huruf atau tulisan yang bersumber dari angka (nominal keuangan) bisa secara otomatis menggunakan macro Visual Basic. Aplikasi rumus excel ini biasanya dibuat ketika kita diharapkan dalam suatu masalah pengolahan keuangan, misalnya saja membuat SPJ di sekolah, atau bisa juga digunakan ketika membuat sebuah kwitansi.

Lihat gambar aplikasi excel untuk rumus terbilang di bawah ini, artikel lain bagaimana untuk membuat sebuah aplikasi excel untuk membuat kwitansi.



Buatlah macro visual basic editor caranya:
- pilih Tools – Macro – Visual Basic Editor



Dan masukan script terbilang untuk membuat angkat terbilang di ms excel di bawah ini

Option Explicit

'***************
' Fungsi Utama
' Mengubah Angka Menjadi Teks
' hak cipta : http://orangmajalengka.com
'***************

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

Membuat Macro di Ms. Excel membuat mudah dalam aplikasi rumus MS. Excel. Untuk memudahkan belajar silakan download aplikasi rumus dan penggunaan macro Disini
Semoga bermanfaat...!