Fungsi Terbilang

Public Function Terbilang(sNilai As String) As String
Dim iPanjang%: Dim iDigit%
Dim iAngka%: Dim iSisa%
Dim iLoop%: Dim iLoopSatuan%
Dim iBatas%

Dim sAngka(9) As String
Dim sDigit() As String
Dim sDigitKalimat() As String
Dim sSatuan(6) As String
Dim sKalimat$: Dim sTeksAngka$
Dim sTeksDigit$: Dim sNilaiPoint$
Dim sDigitPoint() As String
Dim sDigitKalimatPoint() As String
Dim sTeksAngkaPoint$
Dim sNol$: Dim iNol As Integer

Dim bSe As Boolean

sAngka(0) = ""
sAngka(1) = "satu "
sAngka(2) = "dua "
sAngka(3) = "tiga "
sAngka(4) = "empat "
sAngka(5) = "lima "
sAngka(6) = "enam "
sAngka(7) = "tujuh "
sAngka(8) = "delapan "
sAngka(9) = "sembilan "

sSatuan(1) = ""
sSatuan(2) = "ribu "
sSatuan(3) = "juta "
sSatuan(4) = "milyar "
sSatuan(5) = "trilyun "
sSatuan(6) = "bilyun "

If InStr(sNilai, ",") <> 0 Then
sNilaiPoint = Mid(sNilai, InStr(sNilai, ",") + 1)
sNilai = Left(sNilai, InStr(sNilai, ",") - 1)
ElseIf InStr(sNilai, ".") <> 0 Then
sNilaiPoint = Mid(sNilai, InStr(sNilai, ".") + 1)
sNilai = Left(sNilai, InStr(sNilai, ".") - 1)
End If

iLoop = 0
Do While iLoop < Len(sNilaiPoint)
iLoop = iLoop + 1
Select Case Mid(sNilaiPoint, iLoop, 1)
Case "0"
sNol = "nol " & sNol
iNol = iNol + 1
Case Else
Exit Do
End Select
Loop

If sNilaiPoint <> "" Then
sNilaiPoint = Mid(sNilaiPoint, iNol + 1)
End If

'Nilai di belakang koma
Select Case Len(sNilaiPoint)
Case Is > 0
iPanjang = Len(Trim(sNilaiPoint))
Select Case iPanjang Mod 3
Case 0
iDigit = iPanjang / 3
iSisa = 3
Case Else
iDigit = (iPanjang \ 3) + 1
iSisa = iPanjang Mod 3
End Select

ReDim sDigitPoint(iDigit)
ReDim sDigitKalimatPoint(iDigit)

iLoop = 0
While iLoop < iDigit
iLoop = iLoop + 1
Select Case iLoop
Case iDigit
sDigitPoint(iLoop) = Right(sNilaiPoint, iSisa)
Case Else
sDigitPoint(iLoop) = Right(sNilaiPoint, 3)
sNilaiPoint = Left(sNilaiPoint, Len(sNilaiPoint) - 3)
End Select
Wend

sTeksAngka = ""
For iLoop = 1 To iDigit
sNilaiPoint = sDigitPoint(iLoop)

Select Case iLoop
Case iDigit
iBatas = iSisa
Case Else
iBatas = 3
End Select

sTeksAngka = sSatuan(iLoop)

For iLoopSatuan = 1 To iBatas
iAngka = Val(Right(sNilaiPoint, 1))
sNilaiPoint = Left(sNilaiPoint, iBatas - iLoopSatuan)
Select Case iLoopSatuan
Case 2

Select Case iAngka
Case Is <> 0

Select Case iAngka
Case 1

bSe = True
If Val(Right(sDigitPoint(iLoop), 1)) = 0 Then
sTeksAngka = "sepuluh " & sSatuan(iLoop)
ElseIf Val(Right(sDigitPoint(iLoop), 1)) = 1 Then
sTeksAngka = "sebelas " & sSatuan(iLoop)
Else
sTeksAngka = sAngka(Val(Right(sDigitPoint(iLoop), 1))) & _
"belas " & sSatuan(iLoop)
End If

Case Else

bSe = False
sTeksAngka = "puluh " & sTeksAngka

End Select

End Select

Case 3

Select Case iAngka
Case Is <> 0

Select Case iAngka
Case 1

bSe = True
sTeksAngka = "seratus " & sTeksAngka

Case Else

sTeksAngka = "ratus " & sTeksAngka

End Select

End Select

End Select

Select Case bSe
Case True
bSe = False
Case Else

Select Case iLoop
Case 2

If Right(sDigitPoint(2), 1) = 1 And iLoopSatuan = 1 Then
If Len(sDigitPoint(2)) = 1 Then
sTeksAngka = "se" & sTeksAngka
ElseIf Val(Mid(sDigitPoint(2), Len(sDigitPoint(2)) - 1, 1)) = 0 Then
sTeksAngka = "se" & sTeksAngka
Else
sTeksAngka = sAngka(iAngka) & sTeksAngka
End If
Else
sTeksAngka = sAngka(iAngka) & sTeksAngka
End If

Case Else

sTeksAngka = sAngka(iAngka) & sTeksAngka

End Select

End Select
Next

sDigitKalimatPoint(iLoop) = sTeksAngka
sTeksAngka = ""
Next

For iLoop = 1 To iDigit

Select Case sDigitKalimatPoint(iLoop)
Case Is <> sSatuan(iLoop)
sTeksAngka = sDigitKalimatPoint(iLoop) + sTeksAngka
End Select

Next

Select Case sTeksAngka
Case "": sTeksAngka = "nol "
End Select

sTeksAngkaPoint = "koma " & sNol & sTeksAngka

End Select

iPanjang = Len(Trim(sNilai))
Select Case iPanjang Mod 3
Case 0
iDigit = iPanjang / 3
iSisa = 3
Case Else
iDigit = (iPanjang \ 3) + 1
iSisa = iPanjang Mod 3
End Select

ReDim sDigit(iDigit)
ReDim sDigitKalimat(iDigit)

iLoop = 0
While iLoop < iDigit
iLoop = iLoop + 1

Select Case iLoop
Case iDigit
sDigit(iLoop) = Right(sNilai, iSisa)
Case Else
sDigit(iLoop) = Right(sNilai, 3)
sNilai = Left(sNilai, Len(sNilai) - 3)
End Select

Wend

sTeksAngka = ""
For iLoop = 1 To iDigit
sNilai = sDigit(iLoop)
Select Case iLoop
Case iDigit
iBatas = iSisa
Case Else
iBatas = 3
End Select

sTeksAngka = sSatuan(iLoop)

For iLoopSatuan = 1 To iBatas


iAngka = Val(Right(sNilai, 1))
sNilai = Left(sNilai, iBatas - iLoopSatuan)

Select Case iLoopSatuan
Case 2
Select Case iAngka
Case Is <> 0
Select Case iAngka
Case 1

bSe = True
If Val(Right(sDigit(iLoop), 1)) = 0 Then
sTeksAngka = "sepuluh " & sSatuan(iLoop)
ElseIf Val(Right(sDigit(iLoop), 1)) = 1 Then
sTeksAngka = "sebelas " & sSatuan(iLoop)
Else
sTeksAngka = sAngka(Val(Right(sDigit(iLoop), 1))) & _
"belas " & sSatuan(iLoop)
End If

Case Else

bSe = False
sTeksAngka = "puluh " & sTeksAngka
End Select

End Select
Case 3
Select Case iAngka
Case Is <> 0
Select Case iAngka
Case 1
bSe = True
sTeksAngka = "seratus " & sTeksAngka
Case Else
sTeksAngka = "ratus " & sTeksAngka
End Select
End Select
End Select

Select Case bSe
Case True
bSe = False

Case Else
Select Case iLoop
Case 2
If Right(sDigit(2), 1) = 1 And iLoopSatuan = 1 Then
If Len(sDigit(2)) = 1 Then
sTeksAngka = "se" & sTeksAngka
ElseIf Val(Mid(sDigit(2), Len(sDigit(2)) - 1, 1)) = 0 Then
sTeksAngka = "satu " & sTeksAngka
Else
sTeksAngka = sAngka(iAngka) & sTeksAngka
End If
Else
sTeksAngka = sAngka(iAngka) & sTeksAngka
End If
Case Else
sTeksAngka = sAngka(iAngka) & sTeksAngka
End Select

End Select
Next
sDigitKalimat(iLoop) = sTeksAngka
sTeksAngka = ""
Next

For iLoop = 1 To iDigit
Select Case sDigitKalimat(iLoop)
Case Is <> sSatuan(iLoop): sTeksAngka = sDigitKalimat(iLoop) + sTeksAngka
End Select
Next

Select Case sTeksAngka
Case "": sTeksAngka = "nol "
End Select

Terbilang = StrConv(Trim(sTeksAngka + sTeksAngkaPoint), vbProperCase)

End Function


Penggunaan:

Text1.Text = Terbilang("12000,20")

Posted in: Visual Basic