1. Hello Guest, selamat datang di Forum WinPoin. Kamu bisa bertanya, berdiskusi, sharing, dan ngobrolin apapun seputar Windows, Windows Phone, PC, Gadget, atau hal seputar Teknologi lainnya. Selamat berkomunitas! ;)

Fungsi Terbilang Untuk Excel

Discussion in 'Microsoft Office' started by mabaega, Jun 20, 2014.

  1. mabaega

    mabaega Well-Known Member

    Joined:
    Nov 9, 2013
    Messages:
    2,735
    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

    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:
     

    Attached Files:

  2. Chrisnado

    Chrisnado Administrator Staff Member

    Joined:
    May 7, 2013
    Messages:
    1,859
    wusss ini tips kueren banget om, sharenya greget banget om :ketawa:
     
  3. Febian

    Febian Administrator Staff Member

    Joined:
    May 7, 2013
    Messages:
    8,029
    Double +Rep utk share nya
    Saya sampe bingung mau ngomong apa :ketawa:
     
  4. mabaega

    mabaega Well-Known Member

    Joined:
    Nov 9, 2013
    Messages:
    2,735
    Kebetulan ada yang tanya di thread sebelah...
    xi..xi..xi......

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

    Yusril Ibnu Winpoin Staff Staff Member

    Joined:
    May 12, 2014
    Messages:
    6,373
    wah keren nih... jadi lebih mudah dalam membuat terbilang... :kagum:
    +Rep deh dari saya..
     
  6. ilhamajah04

    ilhamajah04 Well-Known Member

    Joined:
    Nov 27, 2013
    Messages:
    4,730
    buat yang kerja ngitungin duit sih berguna nih
     
  7. marwanto.se

    marwanto.se New Member

    Joined:
    May 7, 2013
    Messages:
    7,653
    Excel jarang pake om.. :ketawa:
    Walau begitu, tetap "greget" kok tipsnya. :goodjob:
     

Share This Page