Re: [belajar-excel] terbilang angka lebih ringkes ...?

[siti Vi]

wah panjang amat makronya,
di milis ini kan juga pernah ada posting Fungsi Terbilang yg cukup pendek,
malah mungkin tependek (dari yg pernah siti lihat).

kita tetap membatasi bagian pecahan yaitu angka setelah tanpa pemisah
desimal = 2 digit.
jadi misal input 1.5678 akan dianggap 1.57
tanda pemisah desimal belum tentu koma, tetapi tergantung setting komputer
anda, lazimnya
titik atau koma.
sesuai permintaan, titik atau koma tetap diucapkan "koma", lucu yah..

modifikasi coding-nya, mudah-mudahan ndak salah, sbb

'================================
'***************
' Fungsi Utama
' Mengubah Angka Menjadi Teks
' Eka Priatna
' http://priatna.or.id/
'***************

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 = Mid(MyNumber, Desimal + 1)
        Sen = Terbilang(Tmp)
        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)
          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"
        Case Else
            Rupiah = Rupiah
    End Select

    Select Case Sen
        Case ""
            Sen = ""
        Case Else
            Sen = "koma " & Sen
    End Select

    If IsNeg = True Then
        Terbilang = "minus " & 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

'================================


2008/12/15 mury anto <mury_an...@yahoo.co.id>

>  para suhu suhu excel,ini kan dah jadi rumus =terbilang
> 7,5 = tujuh rupiah dan lima sen
> tolongin dunk biar hasil rumusnya jadi
> 7,5 = tujuh koma lima
>
> ini dah akyu lampirkan macronya, dapet dari sebelah ...hehehe
> tulung yaw
>