Chuyển số thành chữ với VBA Excel

0
34

Làm thế nào để chuyển đổi số thành chữ tiếng Việt trên Excel.

Đầu tiên tạo mới một file Excel và lưu lại với phần mở rộng .xlsm (Excel Macro-Enabled Workbook)

Lựa chọn “Developer” → “Visual Basic

Lựa chọn “Insert” → “Module

Copy đoạn Code sau

Option Explicit

' Main Function
Function SpellNumber(ByVal MyNumber)
    Dim Dollars, Cents, Temp
    Dim DecimalPlace, Count
    ReDim Place(9) As String
    
    Place(2) = " nghìn "
    Place(3) = " tri" & ChrW(7879) & "u "
    Place(4) = " t" & ChrW(7927) & " "
    Place(5) = " nghìn t" & ChrW(7927) & " "
    
    ' String representation of amount.
    MyNumber = Trim(Str(MyNumber))
    
    ' Position of decimal place 0 if none.
    DecimalPlace = InStr(MyNumber, ".")
    
    ' Convert cents and set MyNumber to dollar amount.
    If DecimalPlace > 0 Then
        Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If
    
    Count = 1
    
    Do While MyNumber <> ""
        Temp = GetHundreds(Right(MyNumber, 3))
        
        If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
        
        If Len(MyNumber) > 3 Then
            MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else
            MyNumber = ""
        End If
        
        Count = Count + 1
    Loop
    
    Select Case Dollars
        Case ""
            Dollars = "không vn" & ChrW(273)
        Case "One"
            Dollars = "m" & ChrW(7897) & "t vn" & ChrW(273)
        Case Else
            Dollars = Dollars & " vn" & ChrW(273)
    End Select
    
    Select Case Cents
        Case ""
            Cents = " và không hào"
        Case "One"
            Cents = " và m" & ChrW(7897) & "t hào"
        Case Else
            Cents = " và " & Cents & " hào"
    End Select
    
    SpellNumber = Dollars & Cents

End Function


' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
    Dim Result As String
    
    If Val(MyNumber) = 0 Then Exit Function
    
    MyNumber = Right("000" & MyNumber, 3)
    
    ' Convert the hundreds place.
    If Mid(MyNumber, 1, 1) <> "0" Then
        Result = GetDigit(Mid(MyNumber, 1, 1)) & " tr" & ChrW(259) & "m "
    End If
    
    ' Convert the tens and ones place.
    If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & GetTens(Mid(MyNumber, 2))
    Else
        Result = Result & GetDigit(Mid(MyNumber, 3))
    End If
    
    GetHundreds = Result

End Function


' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
    Dim Result As String
    
    Result = "" ' Null out the temporary function value.
    
    If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
    
        Select Case Val(TensText)
            
            Case 10: Result = "m" & ChrW(432) & ChrW(7901) & "i"
            
            Case 11: Result = "m" & ChrW(432) & ChrW(7901) & "i m" & ChrW(7897) & "t"
            
            Case 12: Result = "m" & ChrW(432) & ChrW(7901) & "i hai"
            
            Case 13: Result = "m" & ChrW(432) & ChrW(7901) & "i ba"
            
            Case 14: Result = "m" & ChrW(432) & ChrW(7901) & "i b" & ChrW(7889) & "n"
            
            Case 15: Result = "m" & ChrW(432) & ChrW(7901) & "i n" & ChrW(259) & "m"
            
            Case 16: Result = "m" & ChrW(432) & ChrW(7901) & "i sáu"
            
            Case 17: Result = "m" & ChrW(432) & ChrW(7901) & "i b" & ChrW(7849) & "y"
            
            Case 18: Result = "m" & ChrW(432) & ChrW(7901) & "i tám"
            
            Case 19: Result = "m" & ChrW(432) & ChrW(7901) & "i chín"
            
            Case Else
            
        End Select
    
    Else ' If value between 20-99...
    
        Select Case Val(Left(TensText, 1))
        
            Case 2: Result = "hai m" & ChrW(432) & ChrW(417) & "i "
            
            Case 3: Result = "ba m" & ChrW(432) & ChrW(417) & "i "
            
            Case 4: Result = "b" & ChrW(7889) & "n m" & ChrW(432) & ChrW(417) & "i "
            
            Case 5: Result = "n" & ChrW(259) & "m m" & ChrW(432) & ChrW(417) & "i "
            
            Case 6: Result = "sáu m" & ChrW(432) & ChrW(417) & "i "
            
            Case 7: Result = "b" & ChrW(7849) & "y m" & ChrW(432) & ChrW(417) & "i "
            
            Case 8: Result = "tám m" & ChrW(432) & ChrW(417) & "i "
            
            Case 9: Result = "chín m" & ChrW(432) & ChrW(417) & "i "
            
            Case Else
        
        End Select
    
        Result = Result & GetDigit(Right(TensText, 1))      ' Retrieve ones place.
    
    End If
    
    GetTens = Result

End Function


' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)

    Select Case Val(Digit)
    
        Case 1: GetDigit = "m" & ChrW(7897) & "t"
        
        Case 2: GetDigit = "hai"
        
        Case 3: GetDigit = "ba"
        
        Case 4: GetDigit = "b" & ChrW(7889) & "n"
        
        Case 5: GetDigit = "n" & ChrW(259) & "m"
        
        Case 6: GetDigit = "sáu"
        
        Case 7: GetDigit = "b" & ChrW(7849) & "y"
        
        Case 8: GetDigit = "tám"
        
        Case 9: GetDigit = "chín"
        
        Case Else: GetDigit = ""
    
    End Select

End Function

Dán vào Module Code vừa tạo

Ấn “Alt + Q” để quay trở lại Excel. Hàm SpellNumber giờ đã sẵn sàng sử dụng

Các bạn cùng chỉnh sửa và ứng dụng nhé

Tham khảo:

  1. Hàm chuyển đổi text Unicode tiếng Việt VBA dùng trên Excel
  2. https://support.microsoft.com/en-us/office/convert-numbers-into-words-a0d166fb-e1ea-4090-95c8-69442cd55d98

BÌNH LUẬN

Vui lòng nhập bình luận của bạn
Vui lòng nhập tên của bạn ở đây