Fungsi Terbilang Untuk Excel

Sekedar Memberi Pilihan Custom Function untuk thread Fungsi Terbilang Excel 2013. Sekaligus melanjutkan Coding Menbuat Fungsi Terbilang dengan VBNet

Saya coba hadirkan Code dibawah, mudah-mudahan bisa jadi alternatif buat rekan-rekan sekalian...
:kagum:

Buka Excel, Tekan ALT+F11
Tambahkan Sebuah Module pada Project Explorer
Dan Copas Code Dibawah

Spoiler

Code:

'VBA Custom Function
'Fungsi Terbilang (Mengubah Angka menjadi Kata
'@2014 By Mabaega@winpoin.com
'
'Penggunaan :
'=Terbilang(ByVal Param1, Optional Param2, Optional Param2)
'Param1 : Berisi Angka Double
'Param2 : Apakah Angka Setelah Koma ikut dibaca.. Default True
'Param3 : Tuliskan Kata yang ingin ditambahkan diakhir Pembacaan
'
'Contoh : =Terbilang(1234,123;1;" Rupiah") akan
'dibaca : Seribu Dua Ratus Tiga Puluh Empat Koma Satu Dua Tiga Rupiah
'Semoga Bermanfaat
'

Option Explicit

    Private Function ToWord(ByVal i As Integer) As String
        Dim sWord() As String
        sWord = Split(", Satu, Dua, Tiga, Empat, Lima, Enam, Tujuh, Delapan, Sembilan, Sepuluh, Sebelas", ",")
        ToWord = sWord(i)
    End Function

    Private Function GrWord(ByVal g As Integer) As String
        Dim sGrp() As String
        sGrp = Split(", Ribu, Juta, Milyar, Triliun", ",")
        If g > 4 Then
            g = g - 4
        End If
        GrWord = sGrp(g)
    End Function

    Public Function Terbilang(ByVal BilInput As Double, Optional BacaKoma As Boolean = True, Optional KataTambahan As String = "") As String
        Dim sRet As String
        Dim sMinus As String
        Dim BilCacah As Double
        Dim BilPecahan As String
        Dim sInput() As String
        Dim sTriple() As String
        Dim i As Integer

        If BilInput < 0 Then sMinus = "Minus "

        sInput = Split(BilInput, Mid(1 / 2, 2, 1))

        BilCacah = sInput(0)
        If UBound(sInput) > 0 Then
            BilPecahan = sInput(1)
        Else
            BilPecahan = ""
        End If
               
        sTriple = Split(Format(BilCacah, "#,##0"), Mid(Format(1000, "#,##0"), 2, 1))
        
        
        For i = LBound(sTriple) To UBound(sTriple)
            sRet = sRet & BacaGroupCacah(sTriple(i), UBound(sTriple) - i)
        Next

        If BacaKoma And Val(BilPecahan) > 0 Then
            sRet = sRet & " Koma" & BacaPecahan(BilPecahan)
        End If

        sRet = sMinus & sRet

        Terbilang = Trim(sRet) & IIf(KataTambahan <> "", KataTambahan, "")

    End Function

    Private Function BacaPecahan(ByVal sAngka As String) As String
        Dim sRet As String
        Dim i As Integer
        
        For i = 1 To Len(sAngka)
            If CInt(Mid(sAngka, i, 1)) = 0 Then
                sRet = sRet & "Nol"
            Else
                sRet = sRet & ToWord(CInt(Mid(sAngka, i, 1)))
            End If
        Next

        BacaPecahan = sRet
    End Function

    Private Function BacaGroupCacah(ByVal Angka As Integer, Optional iGroup As Integer = 0) As String
        Dim sRet As String
        Dim sAngka As String
        Dim sTmp As String

        sAngka = CStr(Angka)

        If Angka <= 11 Then
            sRet = ToWord(Angka)
        ElseIf Angka = 100 Then
            sRet = " Seratus"
        ElseIf Angka < 100 Then
            If Mid(sAngka, 1, 1) = 1 Then
                sRet = ToWord(CInt(Right(sAngka, 1))) & " belas"
            Else
                sTmp = ToWord(CInt(Right(sAngka, 1)))
                sRet = ToWord(CInt(Left(sAngka, 1))) & " Puluh" & sTmp
            End If
        Else
            sTmp = BacaGroupCacah(Right(sAngka, 2))
            If Left(sAngka, 1) = 1 Then
                sRet = "Seratus" & sTmp
            Else
                sRet = ToWord(Mid(sAngka, 1, 1)) & " ratus" & sTmp
            End If
        End If
        
        If Angka = 1 And iGroup = 1 Then
            sRet = " Seribu"
        Else
            sRet = sRet & GrWord(iGroup)
        End If

        BacaGroupCacah = sRet
    End Function
    

Yang gak mau Pusing dengan Code, Bisa Download XLAM Pada Attachment :
Buka Excel, Option, AddIns
Pada Excel AddIns - Combo Manager, Pilih Excel Add-In dan Klick Go.
Kemudia Browse dan Pilih File XALM dari attachment.
Check dan tekan OK.
Fungsi Siap Digunakan.

Penggunaan bisa lihat gambar berikut :

Semoga Bermanfaat.
:sokganteng:

 

Kebetulan ada yang tanya di thread sebelah...
xi..xi..xi......

Jadi iseng coba-coba coding vba... (serasa pake vb5 lagi..)
:ketawa:

 

buat yang kerja ngitungin duit sih berguna nih

 

Excel jarang pake om.. :ketawa:
Walau begitu, tetap "greget" kok tipsnya. :goodjob: