Menu

Selasa, 02 Agustus 2016

Buat No urut diantara dua kolom dengna VBA ( UDF )

Terbilang dengan Rupiah ( UDF VBA Excel )

Public Function Terbilang(x As Currency) Dim triliun As Currency Dim milyar As Currency Dim juta As Currency Dim ribu As Currency Dim satu As Currency Dim sen As Currency Dim baca As String If x > 1000000000000# Then Terbilang = "< di atas satu triliun rupiah >" Exit Function End If 'Jika x adalah 0, maka dibaca sebagai 0 If x = 0 Then baca = angka(0, 1) Else 'Pisah masing-masing bagian untuk triliun, milyar, juta, ribu, rupiah, dan sen triliun = Int(x * 0.001 ^ 4) milyar = Int((x - triliun * 1000 ^ 4) * 0.001 ^ 3) juta = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3) / 1000 ^ 2) ribu = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2) / 1000) satu = Int(x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2 - ribu * 1000) sen = Int((x - Int(x)) * 100) 'Baca bagian triliun dan ditambah akhiran triliun If triliun > 0 Then baca = ratus(triliun, 5) + "triliun " End If 'Baca bagian milyar dan ditambah akhiran milyar If milyar > 0 Then baca = ratus(milyar, 4) + "milyar " End If 'Baca bagian juta dan ditambah akhiran juta If juta > 0 Then baca = baca + ratus(juta, 3) + "juta " End If 'Baca bagian ribu dan ditambah akhiran ribu If ribu > 0 Then baca = baca + ratus(ribu, 2) + "ribu " End If 'Baca bagian rupiah dan ditambah akhiran rupiah If satu > 0 Then baca = baca + ratus(satu, 1) + "rupiah " Else baca = baca + "rupiah" End If 'Baca bagian sen dan ditambah akhiran sen If sen > 0 Then baca = baca + ratus(sen, 0) + "sen" End If End If Terbilang = UCase(Left(baca, 1)) & LCase(Mid(baca, 2)) End Function Function ratus(x As Currency, Posisi As Integer) As String Dim a100 As Integer, a10 As Integer, a1 As Integer Dim baca As String a100 = Int(x * 0.01) a10 = Int((x - a100 * 100) * 0.1) a1 = Int(x - a100 * 100 - a10 * 10) 'Baca Bagian Ratus If a100 = 1 Then baca = "Seratus " Else If a100 > 0 Then baca = angka(a100, Posisi) + "ratus " End If End If 'Baca Bagian Puluh dan Satuan If a10 = 1 Then baca = baca + angka(a10 * 10 + a1, Posisi) Else If a10 > 0 Then baca = baca + angka(a10, Posisi) + "puluh " End If If a1 > 0 Then baca = baca + angka(a1, Posisi) End If End If ratus = baca End Function Function angka(x As Integer, Posisi As Integer) Select Case x Case 0: angka = "Nol" Case 1: If Posisi <= 1 Or Posisi > 2 Then angka = "Satu " Else angka = "Se" End If Case 2: angka = "Dua " Case 3: angka = "Tiga " Case 4: angka = "Empat " Case 5: angka = "Lima " Case 6: angka = "Enam " Case 7: angka = "Tujuh " Case 8: angka = "Delapan " Case 9: angka = "Sembilan " Case 10: angka = "Sepuluh " Case 11: angka = "Sebelas " Case 12: angka = "Duabelas " Case 13: angka = "Tigabelas " Case 14: angka = "Empatbelas " Case 15: angka = "Limabelas " Case 16: angka = "Enambelas " Case 17: angka = "Tujuhbelas " Case 18: angka = "Delapanbelas " Case 19: angka = "Sembilanbelas " End Select End Function