Home » , » Merubah Angka Menjadi Huruf dalam Exel (Terbilang)

Merubah Angka Menjadi Huruf dalam Exel (Terbilang)

Unknown | 1/25/2015 09:14:00 AM | 0 comments
Langkah langkahnya :
Munculkan Menu Developer terlebih dahulu. Caranya :
  • Klik Lingkaran Pojok Kiri atas Microsoft Exel > Exel Option > Popular > Centang "Show developer tab in ribbon" Klik OK
  • Maka akan muncul menu developer  baru di Microsoft Exel
  • Klik Developer > Visual Basic > Insert > Module 
  •  setelah itu paste kan kode berikut :
Public Function konv(vln As Variant) As String
    Dim VCS As String
    Dim vkonv, vTS As String
    Dim v3D
    Dim vTTbl(1 To 5), vtbl(1 To 5) As String
    Dim vX, vN As Byte
    v3D = Array("", "", "Triliun ", "Milyar ", "Juta ", "Ribu ", "", "")
    Static vK As String
    If IsNumeric(vln) = False Then
        konv = "Data Yang Akan di Konversi Harus Angka!!!"
        Exit Function
    End If
        
    vTS = Format(vln, "###")
    If Len(vTS) > 15 Then
        konv = "Digit Terlalu Banyak, mak 15 Digit (Trilyun)"
        Exit Function
    End If
       
    vTS = Format(vln, "000000000000000")
    vK = Mid(vTS, 17, 3)
    vN = 1
    For vX = 1 To 5
        vTTbl(vX) = Mid(vTS, vN, 3)
        vtbl(vX) = funckonv(CDbl(vTTbl(vX)))
        If vtbl(vX) = "" Then
            v3D(vX + 1) = ""
        End If
        
        If vtbl(4) = "Satu " Then
            vtbl(4) = "Se"
            v3D(5) = "ribu "
        End If
        
        vkonv = vkonv & v3D(vX) & vtbl(vX)
        vN = vN + 3
    
    Next vX
    
    If vln = "0" Then
        vkonv = "Nol"
    End If
    
    If vK = "" Then
        konv = "" & vkonv & "Rupiah"
    Else
        Static vT
        vT = funckonv(CDbl(vK))
        konv = "" & vkonv & "Rupiah" & vT & "Sen"
    End If
    
End Function

Public Function funckonv(vA As Double) As String

Dim vkonv$
vkonv$ = ""
Dim vSA As String, vX, vN
Dim vAH, vAA
Dim vH(1 To 30) As String, vA1(1 To 30) As String
vAH = Array("", "Satu ", "Dua ", "Tiga ", "Empat ", "Lima ", "Enam ", "Tujuh ", "Delapan ", "Sembilan ", "Sepuluh ", "Sebelas ", "Dua Belas ")
vAA = Array("", "Puluh ", "Ratus ", "Ribu ", "Puluh ", "Ratus ", "Juta ", "Puluh ", "Ratus ", "Milyar ", "Puluh ", "Ratus ", "Trilyun ", "Puluh ", "Ratus ", "Bilyun ", "Puluh ", "Ratus ")
vSA = CStr(vA)

For vX = 1 To Len(vSA)
    vH(vX) = vAH(Mid(vSA, vX, 1))
    vA1(vX) = vAA(Len(vSA) - vX)
    If vH(vX) = "" Then vA1(vX) = ""
Next vX

If Left(Right(vSA, 2), 1) = 1 And Len(vSA) <> 1 And Val(Right(vSA, 2)) >= 10 Then
    vH(Len(vSA)) = ""
    vH(Len(vSA) - 1) = vAH(Right(vSA, 1))
    vA1(Len(vSA) - 1) = "Belas "
    If vH(Len(vSA) - 1) = "Satu " Then
        vH(Len(vSA) - 1) = "Se"
        vA1(Len(vSA) - 1) = "belas "
    End If
    
    If vH(Len(vSA) - 1) = "" Then
        vH(Len(vSA) - 1) = "Se"
        vA1(Len(vSA) - 1) = "puluh "
    End If
End If

If vH(1) = "Satu " And (Len(vSA) > 1) And (Len(vSA) <= 6) Then
    vH(1) = "Se"
    vA1(1) = LCase(vA1(1))
End If

For vX = 1 To Len(vSA)
    vkonv$ = vkonv$ & vH(vX) & vA1(vX)
Next vX

funckonv = vkonv$
    
End Function


kesini
  • Simpan
  • pada cell A1 Ketik 2500 dan pada cell B1 isikan rumus "=konv(A1)" tanpa tanda petik terus tekan enter dan selesai
  • Maka hasilnya akan seperti ini 
 















Share this article :

0 comments:

 
Support : Create bye Maskolis | Mukhlisin Template |
Copyright © 2014-2015. Mukhlisin Blog's - All Rights Reserved
Template Modify by MukhlisinCreating Website
powered by Ligard Komputer