Fungsi terbilang excel macro VBA

Ada dua macam fungsi terbilang dalam pembuatan angka menjadi teks, yang pertama menurut aturan keuangan dan yang kedua menurut aturan bilangan atau huruf.
keduanya mempunyai fungsi yang berbeda, yang satu ejaan perhitungan menggunakan puluhan ratusan dan ribuan sedangkan yang satunya lagi menterjemahkan digit perdigit huruf.
misal : 25000 dibaca dua puluh lima ribu, 25000 dibaca dua lima nol nol nol. keduanya mempunyai kegunaan dan terapan yang berbeda.

Berikut adalah VBA Kode untuk membuat fungsi terbilang:

Huruf per huruf


Function huruf(ByVal MyNumber)
         Dim Temp
         Dim Number, Cents
         Dim DecimalPlace, Count
         ReDim Place(9) As String
                  MyNumber = Trim(Str(MyNumber))
                  DecimalPlace = InStr(MyNumber, ".")

         If DecimalPlace > 0 Then

            Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
            Cents = ConvertTens(Temp)

            MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
         End If
         Count = 1
         Do While MyNumber <> ""
            Temp = ConvertHundreds(Right(MyNumber, 3))
            If Temp <> "" Then Number = Temp & Place(Count) & Number
            If Len(MyNumber) > 3 Then

               MyNumber = Left(MyNumber, Len(MyNumber) - 3)
            Else
               MyNumber = ""
            End If
            Count = Count + 1
         Loop

        Select Case Number
            Case ""
               Number = "Nol"
            Case "Satu"
               Number = "Satu"
            Case Else
               Number = Number
         End Select

         Select Case Cents
            Case ""
               Cents = " koma Nol"
            Case "Satu"
               Cents = " koma Satu"
            Case Else
               Cents = " koma " & Cents
         End Select

       huruf = Number & Cents
End Function
Private Function ConvertHundreds(ByVal MyNumber)
Dim Result As String

         If Val(MyNumber) = 0 Then Exit Function

         MyNumber = Right("000" & MyNumber, 3)

         If Left(MyNumber, 1) <> "0" Then
            Result = ConvertDigit(Left(MyNumber, 1)) & " Nol "
         End If
         If Mid(MyNumber, 2, 1) <> "0" Then
            Result = Result & ConvertTens(Mid(MyNumber, 2))
         Else
            Result = Result & ConvertDigit(Mid(MyNumber, 3))
         End If
         ConvertHundreds = Trim(Result)
End Function
Private Function ConvertTens(ByVal MyTens)
Dim Result As String

         If Val(Left(MyTens, 1)) = 1 Then
            Select Case Val(MyTens)
               Case 10: Result = "Satu Nol"
               Case 11: Result = "Satu Satu"
               Case 12: Result = "Satu Dua"
               Case 13: Result = "Satu Tiga"
               Case 14: Result = "Satu Empat"
               Case 15: Result = "Satu Lima"
               Case 16: Result = "Satu Enam"
               Case 17: Result = "Satu Tujuh"
               Case 18: Result = "Satu Delapan"
               Case 19: Result = "Satu Sembilan"
               Case Else
            End Select
         Else

            Select Case Val(Left(MyTens, 1))
              Case 0: Result = "Nol "
              Case 2: Result = "Dua "
              Case 3: Result = "Tiga "
              Case 4: Result = "Empat "
              Case 5: Result = "Lima "
              Case 6: Result = "Enam "
              Case 7: Result = "Tujuh "
              Case 8: Result = "Delapan "
              Case 9: Result = "Sembilan "
              Case Else
            End Select

           Result = Result & ConvertDigit(Right(MyTens, 1))
         End If
         ConvertTens = Result
End Function
Private Function ConvertDigit(ByVal MyDigit)
Select Case Val(MyDigit)
            Case 0: ConvertDigit = "Nol"
            Case 1: ConvertDigit = "Satu"
            Case 2: ConvertDigit = "Dua"
            Case 3: ConvertDigit = "Tiga"
            Case 4: ConvertDigit = "Empat"
            Case 5: ConvertDigit = "Lima"
            Case 6: ConvertDigit = "Enam"
            Case 7: ConvertDigit = "Tujuh"
            Case 8: ConvertDigit = "Delapan"
            Case 9: ConvertDigit = "Sembilan"
            Case Else: ConvertDigit = ""
         End Select
End Function

pengaplikasian : tekan alt + f11, copykan kode diatas pada lembar code vba
pada sheet menggunakan rumus =huruf(cell)


untuk ejaan perhitungan (accounting) telah banyak di ulas pada web lain.

Posted in: Tutorials