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.
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.