Đọc Số Tiền Thành Chữ Chuẩn Hóa Đơn & VBA Excel

' =========================================================================
' CODE VBA HÀM ĐỌC SỐ THÀNH CHỮ TRONG EXCEL (CHUẨN KẾ TOÁN VIỆT NAM)
' Hướng dẫn: Nhấn Alt + F11 trong Excel > Insert > Module > Dán toàn bộ code này.
' Sử dụng trong ô: =DocSo(A1) hoặc =DocSo(A1, " đồng chẵn")
' =========================================================================
Function DocSo(ByVal SoTien As Double, Optional ByVal HauTo As String = " đồng chẵn") As String
    Dim ChuSo As Variant, DonVi As Variant
    Dim S As String, i As Integer, Nhom As Integer, KetQua As String
    Dim Tram As Integer, Chuc As Integer, Donvi_so As Integer
    
    If SoTien = 0 Then
        DocSo = "Không" & HauTo
        Exit Function
    End If
    
    ChuSo = Array("không", "một", "hai", "ba", "bốn", "năm", "sáu", "bảy", "tám", "chín")
    DonVi = Array("", "nghìn", "triệu", "tỷ", "nghìn tỷ", "triệu tỷ")
    
    S = Trim(Str(Abs(SoTien)))
    Do While Len(S) Mod 3 <> 0
        S = "0" & S
    Loop
    
    Nhom = Len(S) / 3
    For i = 1 To Nhom
        Tram = Val(Mid(S, (i - 1) * 3 + 1, 1))
        Chuc = Val(Mid(S, (i - 1) * 3 + 2, 1))
        Donvi_so = Val(Mid(S, (i - 1) * 3 + 3, 1))
        
        If Tram <> 0 Or Chuc <> 0 Or Donvi_so <> 0 Then
            KetQua = KetQua & " " & ChuSo(Tram) & " trăm"
            If Chuc = 0 And Donvi_so <> 0 Then KetQua = KetQua & " lẻ " & ChuSo(Donvi_so)
            If Chuc = 1 Then KetQua = KetQua & " mười"
            If Chuc > 1 Then KetQua = KetQua & " " & ChuSo(Chuc) & " mươi"
            If Chuc > 0 And Donvi_so = 1 Then KetQua = KetQua & " mốt"
            If Chuc > 0 And Donvi_so = 5 Then KetQua = KetQua & " lăm"
            If Chuc > 1 And Donvi_so > 1 And Donvi_so <> 5 Then KetQua = KetQua & " " & ChuSo(Donvi_so)
            If Chuc = 1 And Donvi_so > 1 And Donvi_so <> 5 Then KetQua = KetQua & " " & ChuSo(Donvi_so)
            KetQua = KetQua & " " & DonVi(Nhom - i)
        End If
    Next i
    
    KetQua = Trim(KetQua)
    If Len(KetQua) > 0 Then
        KetQua = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
    End If
    If SoTien < 0 Then KetQua = "Âm " & LCase(KetQua)
    DocSo = KetQua & HauTo
End Function