TẠO HÀM ĐỌC SỐ THÀNH CHỮ - TRÊN EXCEL

 

MỞ EXCEL VÀ LÀM THEO CÁC BƯỚC

• Nhấn Alt + F11 → cửa sổ VBA.

• Bên trái chọn VBAProject (MDTA.xlsm) → Modules → Module1.

• Trong cửa sổ bên phải: Ctrl + A → Delete để xoá hết.

• Dán NGUYÊN KHỐI code này:

'=== HÀM GỌI TỪ EXCEL ==================================

Function MD(ByVal SoTien As Variant) As String

    Dim tmp As String

    Dim n As Double

    Dim s As String

    

    ' N?u ô l?i ho?c r?ng thì b? qua

    If IsError(SoTien) Then

        MD = ""

        Exit Function

    End If

    

    tmp = Trim(CStr(SoTien))

    If tmp = "" Then

        MD = ""

        Exit Function

    End If

    

    ' B? d?u cách / . / , d? ch?p nh?n c? 1.093.490.000

    tmp = Replace(tmp, " ", "")

    tmp = Replace(tmp, ".", "")

    tmp = Replace(tmp, ",", "")

    

    If Not IsNumeric(tmp) Then

        MD = ""

        Exit Function

    End If

    

    n = CDbl(tmp)

    

    s = NumberToWordsVN(n)

    s = ProperCaseVN(s)

    

    MD = s

End Function

'=== VI?T HOA CH? CÁI Ð?U M?I T? ======================

Private Function ProperCaseVN(ByVal text As String) As String

    Dim arr() As String

    Dim i As Long

    

    arr = Split(text, " ")

    For i = LBound(arr) To UBound(arr)

        If Len(arr(i)) > 0 Then

            arr(i) = UCase(Left(arr(i), 1)) & Mid(arr(i), 2)

        End If

    Next i

    

    ProperCaseVN = Join(arr, " ")

End Function

'=== Ð?C S? NGUYÊN THÀNH CH? TI?NG VI?T (chua vi?t hoa) ==

Private Function NumberToWordsVN(ByVal SoTien As Double) As String

    Dim Chu(9) As String

    Dim Hang(4) As String

    Dim TuDong As String

    Dim n As Double

    Dim block As Long

    Dim blockIndex As Long

    Dim part As String

    Dim result As String

    Dim TenHang As String

    

    ' 0 d?ng

    If SoTien = 0 Then

        NumberToWordsVN = "k" & "h" & ChrW(244) & "n" & "g " & ChrW(273) & ChrW(7891) & "n" & "g"   'không d?ng

        Exit Function

    End If

    

    ' Ch? s? 0–9

    Chu(0) = "k" & "h" & ChrW(244) & "n" & "g"

    Chu(1) = "m" & ChrW(7897) & "t"

    Chu(2) = "h" & "a" & "i"

    Chu(3) = "b" & "a"

    Chu(4) = "b" & ChrW(7889) & "n"

    Chu(5) = "n" & ChrW(259) & "m"

    Chu(6) = "s" & ChrW(225) & "u"

    Chu(7) = "b" & ChrW(7843) & "y"

    Chu(8) = "t" & ChrW(225) & "m"

    Chu(9) = "c" & "h" & ChrW(237) & "n"

    

    ' B?c: 0=don v?, 1=nghìn, 2=tri?u, 3=t?, 4=nghìn t?

    Hang(0) = ""

    Hang(1) = "n" & "g" & "h" & ChrW(236) & "n"          ' nghìn

    Hang(2) = "t" & "r" & "i" & ChrW(7879) & "u"         ' tri?u

    Hang(3) = "t" & ChrW(7927)                           ' t?

    Hang(4) = Hang(1) & " " & Hang(3)                    ' nghìn t?

    

    TuDong = ChrW(273) & ChrW(7891) & "n" & "g"          ' d?ng

    

    n = Abs(SoTien)

    result = ""

    blockIndex = 0

    

    Do While n >= 1

        block = n - 1000 * Int(n / 1000)   ' 3 s? cu?i

        n = Int(n / 1000)

        

        If block <> 0 Then

            part = Read3DigitsVN(block, Chu)

            

            If blockIndex <= 4 Then

                TenHang = Hang(blockIndex)

            Else

                TenHang = Hang(3)          ' trên nghìn t?: t?m gom là "t?"

            End If

            

            If TenHang <> "" Then

                part = part & " " & TenHang

            End If

            

            If result = "" Then

                result = part

            Else

                result = part & " " & result

            End If

        End If

        

        blockIndex = blockIndex + 1

    Loop

    

    result = Trim(result & " " & TuDong)

    

    If SoTien < 0 Then

         result = ChrW(194) & "m " & result   ' Âm

    End If

    

    NumberToWordsVN = result

End Function

'=== Ð?C 3 CH? S? ======================================

Private Function Read3DigitsVN(ByVal So As Long, Chu() As String) As String

    Dim Tram As Long, Chuc As Long, DonVi As Long

    Dim KQ As String

    Dim TuTram As String, TuMuoi As String, TuMuoi10 As String

    Dim TuLe As String, TuLam As String, TuMot As String, TuMot2 As String

    TuTram = "t" & "r" & ChrW(259) & "m"                ' tram

    TuMuoi = "m" & ChrW(432) & ChrW(417) & "i"          ' muoi

    TuMuoi10 = "m" & ChrW(432) & ChrW(7901) & "i"       ' mu?i

    TuLe = "l" & ChrW(7867)                             ' l?

    TuLam = "l" & ChrW(259) & "m"                       ' lam

    TuMot = "m" & ChrW(7897) & "t"                      ' m?t

    TuMot2 = "m" & ChrW(7889) & "t"                     ' m?t (?)

    Tram = So \ 100

    Chuc = (So Mod 100) \ 10

    DonVi = So Mod 10

    KQ = ""

    ' --- Tram ---

    If Tram > 0 Then

        KQ = Chu(Tram) & " " & TuTram

    End If

    ' --- Ch?c ---

    If Chuc > 1 Then

        If KQ <> "" Then KQ = KQ & " "

        KQ = KQ & Chu(Chuc) & " " & TuMuoi

        Select Case DonVi

            Case 0

                ' 20,30...

            Case 1

                KQ = KQ & " " & TuMot2      ' 21,31 => m?t

            Case 5

                KQ = KQ & " " & TuLam       ' 25,35 => lam

            Case Else

                KQ = KQ & " " & Chu(DonVi)

        End Select

    ElseIf Chuc = 1 Then

        If KQ <> "" Then KQ = KQ & " "

        KQ = KQ & TuMuoi10

        Select Case DonVi

            Case 0

                ' 10

            Case 5

                KQ = KQ & " " & TuLam       ' 15 => mu?i lam

            Case Else

                ' 11,12,13...

                KQ = KQ & " " & Chu(DonVi)

        End Select

    Else

        ' --- Chuc = 0 ---

        If DonVi > 0 Then

            If Tram > 0 Then

                KQ = KQ & " " & TuLe        ' 101 => m?t tram l? m?t

            ElseIf KQ <> "" Then

                KQ = KQ & " "

            End If

            Select Case DonVi

                Case 5

                    ' 105 = m?t tram l? nam (không dùng lam)

                    KQ = KQ & " " & Chu(5)

                Case 1

                    KQ = KQ & " " & TuMot

                Case Else

                    KQ = KQ & " " & Chu(DonVi)

            End Select

        End If

    End If

    Read3DigitsVN = Application.WorksheetFunction.Trim(KQ)

End Function

• Vào menu Debug → Compile VBAProject

  • Nếu không báo lỗi là OK.

• Ctrl + S để lưu MDTA.xlsm.

• Đóng VBA, quay lại Excel.