Thursday, July 20, 2023

Script Excel untuk fungsi Terbilang (Berbahasa Indonesia)

 Langsung saja tanpa basa-basi.

Script ini sama dengan fungsi rumus =BAHTTEXT(.....)

Jika mau langsung tanpa instal pastikan file excel anda di simpan dengan ekstensi yang support makro (.xlsm)

berikut kode script yang harus di masukan ke modul VBA.

masuk ke menu Visual basic, kemudian Insert -> module.

lalu pastekan kode berikut :

_____________________________________________________________

Function Ratusan(cData As String) As String

   Dim DataDepan, nLenData, nCount As Integer

   Dim SisaData, cHuruf As String

   Dim Satuan, Imbuhan As Variant

   Satuan = Array(" nol", " satu", " dua", " tiga", " empat", " lima", " enam", " tujuh", " delapan", " sembilan")

   Imbuhan = Array("", "", " puluh", " ratus")

   nLenData = Len(cData)

   SisaData = ""

   cHuruf = ""

   For nCount = nLenData To 1 Step -1

     DataDepan = Val(Mid(cData, 1, 1))

     SisaData = Mid(cData, 2, Len(cData))

     If Not (DataDepan = 0) Then

        If ((nCount = 2) And (CInt(Val(cData)) > 10) And (CInt(Val(cData)) < 20)) Then

            cHuruf = cHuruf + IIf(CInt(Val(SisaData)) = 1, " se", Satuan(CInt(Val(SisaData))))

            cHuruf = cHuruf + IIf(CInt(Val(SisaData)) = 1, "", " ") + "belas"

            GoTo Keluar

        Else

            cHuruf = cHuruf + IIf((DataDepan = 1) And (Not (nCount = 1)), " se", Satuan(DataDepan)):

            cHuruf = cHuruf + IIf((DataDepan = 1) And (Not (nCount = 1)), Trim(Imbuhan(nCount)), Imbuhan(nCount))

        End If

     End If

     cData = SisaData

   Next

Keluar:

   Ratusan = cHuruf

   End Function


Function Isi(cAngka As String) As String

   Dim nCount, nLenData As Integer

   Dim cHuruf, cData As String

   Dim Akhiran As Variant

   Akhiran = Array("", "", " ribu", " juta", " milyar", " triliun", " biliun", " ziliun")

   cHuruf = ""

   cData = ""

   nLenData = Fix(Len(cAngka) / 3) + IIf((Len(cAngka) Mod 3) = 0, 0, 1)

   For nCount = nLenData To 1 Step -1

       cData = Mid(cAngka, 1, IIf(Len(cAngka) - (3 * (nCount - 1)) > 0, Len(cAngka) - (3 * (nCount - 1)), 1))

       If Not (Fix(Val(cData)) = 0) Then

          cHuruf = cHuruf + IIf((nCount = 2) And (CInt(Val(cData)) = 1), " se", Ratusan(cData))

          cHuruf = cHuruf + IIf((nCount = 2) And (CInt(Val(cData)) = 1), Trim(Akhiran(nCount)), Akhiran(nCount))

          cHuruf = Replace(cHuruf, "se ribu", "seribu")

       End If

       cAngka = Right(cAngka, 3 * (nCount - 1))

   Next

   Isi = cHuruf

   End Function

Function Terbilang(nNumber As Double) As String

   Dim cHuruf, cNumber, cFullNumber, cDecsNumber As String

   Dim nPosDecs As Integer

   If VarType(nNumber) = 2 Then

    nNumber = CDbl(CStr(Fix(nNumber)) + Application.DecimalSeparator + "0")

   Else

     nNumber = nNumber

   End If

   cHuruf = ""

   If nNumber < 0 Then

      cHuruf = " minus"

      cNumber = Trim(CStr((nNumber * -1)))

   Else

      cNumber = Trim(CStr(nNumber))

   End If

   nPosDecs = InStr(cNumber, Application.DecimalSeparator)

   cFullNumber = Mid(cNumber, 1, IIf(nPosDecs = 0, Len(cNumber), nPosDecs - 1))

   cDecsNumber = Right(cNumber, Len(cNumber) - IIf(nPosDecs = 0, Len(cNumber), nPosDecs))

   If Not (Fix(Val(cFullNumber)) = 0) Then

      cHuruf = cHuruf + Isi(CStr(cFullNumber))

   Else

      cHuruf = " nol"

   End If

   If Not (cDecsNumber = "") Then

     If Not (Fix(Val(cDecsNumber)) = 0) Then

        cHuruf = cHuruf + " koma" + Isi(cDecsNumber)

     End If

   End If

   Terbilang = cHuruf

   

End Function


_____________________________________________________________

No comments:

Post a Comment

今生缘 (jīn shēng yuán) Affinities of this life | Lyrics Translation

今生缘 (jīn shēng yuán) Affinities of this life | Lyrics Translation 作词/作曲/演唱: 川子 zuò cí/zuò qǔ/yǎn chàng:chuān zǐ Lyricist/Composer/Artist: Ch...