Kode Program membuat Fungsi terbilang di Ms. Excel


Option Explicit

Public Function Terbilang(x As Double) As String
Dim tampung As Double
Dim teks As String
Dim bagian As String
Dim i As Integer
Dim tanda As Boolean
Dim pecah As Double
Dim blkg As String

Dim letak(5)
letak(1) = “ribu ”
letak(2) = “juta ”
letak(3) = “milyar ”
letak(4) = “trilyun ”

‘ ini untuk angka di belakang koma
If (Int(x) <> x) Then
pecah = Round(x – Int(x), 4)
blkg = belakang(pecah)
x = Int(x)
Else
blkg = “”
End If
”’

If (x = 0) Then
Terbilang = “nol ” & blkg
Exit Function
End If

If (x < 2000) Then
tanda = True
End If
teks = “”

If (x >= 1E+15) Then
Terbilang = “Nilai terlalu besar”
Exit Function
End If

For i = 4 To 1 Step -1
tampung = Int(x / (10 ^ (3 * i)))
If (tampung > 0) Then
bagian = ratusan(tampung, tanda)
teks = teks & bagian & letak(i)
End If
x = x – tampung * (10 ^ (3 * i))
Next

teks = teks & ratusan(x, False)
Terbilang = teks & blkg
End Function

Function ratusan(ByVal y As Double, ByVal flag As Boolean) As String
Dim tmp As Double
Dim bilang As String
Dim bag As String
Dim j As Integer

Dim angka(9)
angka(1) = “se”
angka(2) = “dua ”
angka(3) = “tiga ”
angka(4) = “empat ”
angka(5) = “lima ”
angka(6) = “enam ”
angka(7) = “tujuh ”
angka(8) = “delapan ”
angka(9) = “sembilan ”

Dim posisi(2)
posisi(1) = “puluh ”
posisi(2) = “ratus ”

bilang = “”
For j = 2 To 1 Step -1
tmp = Int(y / (10 ^ j))
If (tmp > 0) Then
bag = angka(tmp)
If (j = 1 And tmp = 1) Then
y = y – tmp * 10 ^ j
If (y >= 1) Then
posisi(j) = “belas ”
Else
angka(y) = “se”
End If
bilang = bilang & angka(y) & posisi(j)
ratusan = bilang
Exit Function
Else
bilang = bilang & bag & posisi(j)
End If
End If
y = y – tmp * 10 ^ j
Next

If (flag = False) Then
angka(1) = “satu ”
End If
bilang = bilang & angka(y)
ratusan = bilang
End Function

Function belakang(ByVal pch As Double) As String
Dim strblk(10)
Dim pj As Integer
Dim strpch As String
Dim i As Integer
Dim strbel As String
Dim tmp As String

strblk(1) = “nol ”
strblk(2) = “satu ”
strblk(3) = “dua ”
strblk(4) = “tiga ”
strblk(5) = “empat ”
strblk(6) = “lima ”
strblk(7) = “enam ”
strblk(8) = “tujuh ”
strblk(9) = “delapan ”
strblk(10) = “sembilan ”

strbel = “”
strpch = Str(pch)
pj = Len(strpch)
For i = 3 To pj
tmp = Mid(strpch, i, 1)
strbel = strbel & strblk(CInt(tmp) + 1)
Next
belakang = “koma ” & strbel
End Function

Categories: Ilmu Pengetahuan, Komputer | 3 Komentar

Navigasi pos

3 thoughts on “Kode Program membuat Fungsi terbilang di Ms. Excel

  1. Ping-balik: MEMBUAT FUNGSI TERBILANG DI MS. EXCEL « elang tak bersayap

  2. Ok, para pembaca semoga kode program ini membantu kalian yang sedang kebingungan membuat fungsi terbilang di Ms. Excel tinggal di copy masukan ke Visual Basic for Application.

  3. Ping-balik: FUNGSI TERBILANG DI EXCEL PART 2 « elang tak bersayap

Tinggalkan Balasan

Please log in using one of these methods to post your comment:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s

Buat situs web atau blog gratis di WordPress.com.

%d blogger menyukai ini: