Selasa, 26 Juni 2007

Function Terbilang

Buat Function Terbilang yuk !!!

Function terbilang adalah function yang menyajikan tulisan angka menjadi huruf seperti "1" menjadi "satu" dan seterusnya. Setahuq di excel original, function terbilang belum ada, maka kita bisa menambahkannya sendiri. Mungkin function ini sangat dibutuhkan dalam pekerjaan kantor atau tugas kita nantinya. Untuk itu kita harus mulai membiasakan bekerja dengan funtion pada excel termasuk membuatnya. Biar ga' jadi pemakai aja! Untuk menambah funtion pada excel, anda bisa lihat pada menu "function pada excel". Kali ini aq kasih tau kode program untuk membuat function terbilang:


Kode Program:

Function TERBILANG(Angka As Double) As String
'Program TERBILANG dan TITIK
'TERBILANG = Ubah Angka menjadi Huruf
'TITIK = Pemberian Titik pada Ribuan

Dim Panjang As Integer
Dim AngkaI(15) As Integer
Dim Nomor(9), Hurufke(15) As String
Dim StrAngka, Temp As String

'Inisialisasi

Nomor(1) = "satu "
Nomor(2) = "dua "
Nomor(3) = "tiga "
Nomor(4) = "empat "
Nomor(5) = "lima "
Nomor(6) = "enam "
Nomor(7) = "tujuh "
Nomor(8) = "delapan "
Nomor(9) = "sembilan "
StrAngka = Str(Angka)
Panjang = Len(Str(Angka)) - 1

'TERBILANG: ubah angka jadi huruf
'Tambahkan Angka 0000 didepan Angka Asli menjadi string
'dengan Variabel StrAngka
'contoh StrAngka = "000012345"

StrAngka = ""
For i = 1 To 15 - Panjang
StrAngka = "0" + StrAngka
Next i
StrAngka = StrAngka + Right(Str(Angka), Panjang)

'Ambil masing-masing Angka dari Belakang ke depan
'Digit 1 = Satuan ; Digit 2 = Puluhan
‘Digit 3 = Ratusan ;Digit 4 = Ribuan
‘Digit 5 = Puluhan Ribu ; dst......

For i = 1 To 15
AngkaI(i) = Val(Mid(StrAngka, 16 - i, 1))
Next i

'Ubah menjadi Huruf
'Satuan = digit Terakhir

If AngkaI(2) = 0 Then
Hurufke(1) = Nomor(AngkaI(1))

End If

If Angka = 0 Then
Hurufke(1) = "nol"
End If

'Puluhan = digit ke 2 dari belakang, Untuk digit ke 5,8,11 dst...
‘merupakan puluhan ribu, puluhan juta dst..

For i = 2 To 15 Step 3
Select Case AngkaI(i)
Case 0 'Bila Angka Puluhan = 0 -> Temp = ""
Temp = ""
Case 1 'Bila Angka Puluhan = 1

'Check Angka dibelakangnya

Select Case AngkaI(i - 1)
Case 0 'Bila = 0 -> Temp = "sepuluh"
Temp = "sepuluh "
Case 1 'Bila = 1 -> Temp = "sebelas
Temp = "sebelas "
Case Else 'Bila Angka dibelakangnya > 1 -> Temp = "xxxbelas"
Temp = Nomor(AngkaI(i - 1)) + "belas "
End Select

Case Else

'Bila Angka puluhan > 1
'maka Temp = "xxx puluh yyy"
Temp = Nomor(AngkaI(i)) + "puluh " + Nomor(AngkaI(i - 1))
End Select

Hurufke(i) = Temp
Next i

'Ratusan
'Digit Ke 3, 6, 9, ... dst merupakan ratusan, ratusan ribu,
‘ratusan juta dst..

For i = 3 To 15 Step 3
Select Case AngkaI(i)
Case 0
Temp = ""
Case 1
Temp = "seratus "
Case Else
Temp = Nomor(AngkaI(i)) + "ratus "
End Select
Hurufke(i) = Temp

Next i



'Ribuan, Jutaan, Miliar, Triliun
'Digit ke 4 = Ribuan
'Digit ke 7 = Jutaan
'Digit ke 10 = Miliar
'Digit ke 13 = Triliun

For i = 4 To 15 Step 3
If AngkaI(i + 1) = 0 Then
Temp = Nomor(AngkaI(i))
Else
Temp = ""
End If

Select Case i
Case 4
If AngkaI(4) = 1 And AngkaI(5) = 0 And AngkaI(6) = 0 Then
Temp = "seribu "
Else
Temp = Temp + "ribu "
End If
Case 7
Temp = Temp + "juta "
Case 10
Temp = Temp + "miliar "
Case 13
Temp = Temp + "triliun "
End Select

'Check apakah Pada digit ke(i), ke (i+1) , ke (i+2)
'bila semuanya = 0 -> Hurufke(i) = ""
'Bila tidak -> Hurufke(i) = temp

If AngkaI(i) = 0 And AngkaI(i + 1) = 0 And AngkaI(i + 2) = 0 Then
Hurufke(i) = ""
Else
Hurufke(i) = Temp
End If

Next i

TERBILANG = ""
For i = 1 To 15
TERBILANG = TERBILANG + Hurufke(16 - i)
Next i

End Function


3 komentar:

  1. Klu fungsi terbilang kan sudah banyak!
    Klu dalam bahasa inggris gimana?

    BalasHapus
  2. Hatur nuhun Neng Shanty, algoritmanya kepake...

    Saya coba disederhanakan dan jadi lebih simple namun masih bermasalah dalam milyaran... (udah ga mau mikir kali ya heheh). Ini nih syntaknya :

    Public Function TbLg(ByVal x As Single) As String

    Dim sat As Variant
    sat = Array("", "Satu", "Dua", "Tiga", "Empat", "Lima", "Enam", "Tujuh", "Delapan", "Sembilan", "Sepuluh", "Sebelas")

    If x < 12 Then
    TbLg = " " & sat(x)
    ElseIf x < 20 Then
    TbLg = TbLg(x - 10) & " Belas"
    ElseIf x < 100 Then
    TbLg = TbLg(x \ 10) & " Puluh" & TbLg(x Mod 10)
    ElseIf x < 200 Then
    TbLg = " Seratus" & TbLg(x - 100)
    ElseIf x < 1000 Then
    TbLg = TbLg(x \ 100) & " Ratus" & TbLg(x Mod 100)
    ElseIf x < 2000 Then
    TbLg = " Seribu" & TERBILANG(x - 1000)
    ElseIf x < 1000000 Then
    TbLg = TbLg(x \ 1000) & " Ribu" & TbLg(x Mod 1000)
    ElseIf x < 1000000000 Then
    TbLg = TERBILANG(x \ 1000000) & "Juta" & TbLg(x Mod 1000000)
    ElseIf x < 1000000000000# Then
    TbLg = TERBILANG(x \ 1000000000) & "Milyar" & TbLg(x Mod 1000000000)

    Kalau ada yang bisa ngembangin kasih tau ya...... Hatur tenkyu.

    BalasHapus

Tukeran link yukk!!!

Logo aq disini...
Host Gambar Gratis