Đọc số thành chữ 3 trong 1

[hoangdanh282vn]

Đọc số thành chữ VND 3 trong 1

Gửi các bạn hàm chuyển đổi số thành chữ ReadNum. Hàm này có thể chuyển đổi số thành chữ với 3 loại Font khác nhau.

ReadNum(So, [Font], [Loai])
So : Số cần đọc, bắt buộc
Font : Tùy chọn
+ "vni" : sử dụng Font Vni
+ "uni" hoặc để trống : sử dụng Font Unicode
+ "tcv" : sử dụng Font Tcvn3
Loai : Tùy chọn
+ True hoặc để trống : Sử dụng "đồng" ở cuối câu
+ False : không sử dụng "đồng" ở cuối câu

Các bạn xem them trong file hướng dẫn nha.

Function ReadNum(So, Optional Font As String = "uni", Optional loai As Boolean = True) As String
Dim am As String, dong As String, le As String, khong As String
Dim mot1 As String, mot2 As String, bon As String, nam As String
Dim lam As String, sau As String, bay As String, tam As String
Dim chin As String, muoi1 As String, muoi2 As String
Dim tram As String, nghin As String, trieu As String, ty As String
Dim docdonvi As String, docchuc As String, doctram As String
Dim docnghin As String, docchucnghin As String, doctramnghin As String
Dim doctrieu As String, docchuctrieu As String, doctramtrieu As String
Dim docty As String, docchucty As String, doctramty As String
Application.Volatile (False)
'hoangdanh282vn@ yahoo.com
If Trim(So) = vbNullString Then Exit Function
On Error Resume Next
So = Round(Replace(So, " ", ""))
If Err.Number <> 0 Then
    ReadNum = "Wrong Number !"
    Exit Function
End If
Select Case UCase(Font)
    Case "UNI"
        am = ChrW(194) & "m ": khong = "kh" & ChrW(244) & "ng"
        mot1 = "m" & ChrW(7897) & "t": mot2 = "m" & ChrW(7889) & "t"
        bon = "b" & ChrW(7889) & "n": nam = "n" & ChrW(259) & "m"
        lam = "l" & ChrW(259) & "m": sau = "s" & ChrW(225) & "u"
        bay = "b" & ChrW(7843) & "y": tam = "t" & ChrW(225) & "m"
        chin = "ch" & ChrW(237) & "n": le = "l" & ChrW(7867)
        muoi1 = "m" & ChrW(432) & ChrW(7901) & "i"
        muoi2 = "m" & ChrW(432) & ChrW(417) & "i"
        tram = "tr" & ChrW(259) & "m": nghin = "ngh" & ChrW(236) & "n"
        trieu = "tri" & ChrW(7879) & "u": ty = "t" & ChrW(7927)
        dong = " " & ChrW(273) & ChrW(7891) & "ng."
    Case "VNI"
        am = "AÂm ": le = "leû": khong = "khoâng": mot1 = "moät": mot2 = "moát"
        bon = "boán": nam = "naêm": lam = "laêm": sau = "saùu": bay = "baûy"
        tam = "taùm": chin = "chín": muoi1 = "möôøi": muoi2 = "möôi"
        tram = "traêm": nghin = "nghìn": trieu = "trieäu": ty = "tyû"
        dong = " ñoàng."
    Case "TCV"
        am = "¢m ": le = "lÎ": khong = "kh«ng": mot1 = "mét": mot2 = "mèt"
        bon = "bèn": nam = "n¨m": lam = "l¨m": sau = "s¸u"
        bay = "b¶y": tam = "t¸m": chin = "chÝn": muoi1 = "m­êi": muoi2 = "m­¬i"
        tram = "tr¨m": nghin = "ngh×n": trieu = "triÖu": ty = "tû"
        dong = " ®ång."
End Select
Select Case Abs(So)
    Case 0:
        ReadNum = khong
        Exit Function
    Case Is > 999999999999#:
        ReadNum = "Too great number !"
        Exit Function
End Select
If So > 0 Then am = ""
So = StrReverse(Abs(So))
docdonvi = IIf(Left(So, 1) = 0, "", Choose(Left(So, 1), IIf(Val(Mid(So, 2, 1)) > 1, mot2, mot1), _
            "hai", "ba", bon, IIf(Val(Mid(So, 2, 1)) = 0, nam, lam), sau, bay, tam, chin))
ReadNum = docdonvi
If Len(So) = 1 Then GoTo Tiep

If Val(Mid(So, 2, 1)) = 0 Then
    docchuc = IIf(Left(So, 1) > 0 And Len(So) > 2, le, "")
Else
    docchuc = Choose(Mid(So, 2, 1), muoi1, "hai", "ba", bon, nam, sau, bay, tam, chin)
    docchuc = IIf(docchuc = muoi1, muoi1, docchuc & " " & muoi2)
End If
ReadNum = docchuc & " " & ReadNum
If Len(So) = 2 Then GoTo Tiep

doctram = IIf(Val(Left(So, 3)) = 0, "", IIf(Val(Mid(So, 3, 1)) = 0 And Val(Left(So, 2)) > 0, _
    khong, Choose(Val(Mid(So, 3, 1)), mot1, "hai", "ba", bon, nam, sau, bay, tam, chin)) & " " & tram)
ReadNum = doctram & " " & ReadNum
If Len(So) = 3 Then GoTo Tiep

docnghin = IIf(Val(Mid(So, 4, 1)) = 0 And Val(Mid(So, 5, 1)) > 0, nghin, IIf(Val(Mid(So, 4, 1)) = 0, "", _
            Choose(Mid(So, 4, 1), IIf(Val(Mid(So, 5, 1)) > 1, mot2, mot1), "hai", "ba", bon, _
            IIf(Val(Mid(So, 5, 1)) = 0, nam, lam), sau, bay, tam, chin) & " " & nghin))
ReadNum = docnghin & ", " & ReadNum
If Len(So) = 4 Then GoTo Tiep

If Val(Mid(So, 5, 1)) = 0 Then
    docchucnghin = IIf(Val(Mid(So, 4, 1)) > 0 And Len(So) > 5, le, "")
Else
    docchucnghin = Choose(Mid(So, 5, 1), muoi1, "hai", "ba", bon, nam, sau, bay, tam, chin)
    docchucnghin = IIf(docchucnghin = muoi1, muoi1, docchucnghin & " " & muoi2)
End If
ReadNum = docchucnghin & " " & ReadNum
If Len(So) = 5 Then GoTo Tiep


If Val(Mid(So, 6, 1)) > 0 And Val(Mid(So, 4, 2)) = 0 Then
    doctramnghin = Choose(Mid(So, 6, 1), mot1, "hai", "ba", bon, nam, sau, bay, tam, chin) _
                            & " " & tram & " " & nghin
ElseIf Val(Mid(So, 6, 1)) = 0 And Val(Mid(So, 4, 2)) > 0 Then
    doctramnghin = khong & " " & tram
ElseIf Val(Mid(So, 4, 3)) = 0 Then
    doctramnghin = ""
Else
     doctramnghin = Choose(Mid(So, 6, 1), mot1, "hai", "ba", bon, nam, sau, bay, tam, chin) _
                            & " " & tram
End If
ReadNum = doctramnghin & " " & ReadNum
If Len(So) = 6 Then GoTo Tiep

doctrieu = IIf(Val(Mid(So, 7, 1)) = 0 And Val(Mid(So, 8, 1)) > 0, trieu, IIf(Val(Mid(So, 7, 1)) = 0, "", _
            Choose(Mid(So, 7, 1), IIf(Val(Mid(So, 8, 1)) > 1, mot2, mot1), "hai", "ba", bon, _
            IIf(Val(Mid(So, 8, 1)) = 0, nam, lam), sau, bay, tam, chin) & " " & trieu))
ReadNum = doctrieu & ", " & ReadNum
If Len(So) = 7 Then GoTo Tiep

If Val(Mid(So, 8, 1)) = 0 Then
    docchuctrieu = IIf(Val(Mid(So, 7, 1)) > 0 And Len(So) > 8, le, "")
Else
    docchuctrieu = Choose(Mid(So, 8, 1), muoi1, "hai", "ba", bon, nam, sau, bay, tam, chin)
    docchuctrieu = IIf(docchuctrieu = muoi1, muoi1, docchuctrieu & " " & muoi2)
End If
ReadNum = docchuctrieu & " " & ReadNum
If Len(So) = 8 Then GoTo Tiep

If Val(Mid(So, 9, 1)) > 0 And Val(Mid(So, 7, 2)) = 0 Then
    doctramtrieu = Choose(Mid(So, 9, 1), mot1, "hai", "ba", bon, nam, sau, bay, tam, chin) _
                           & " " & tram & " " & trieu
ElseIf Val(Mid(So, 9, 1)) = 0 And Val(Mid(So, 7, 2)) > 0 Then
    doctramtrieu = khong & " " & tram
ElseIf Val(Mid(So, 7, 3)) = 0 Then
    doctramtrieu = ""
Else
     doctramtrieu = Choose(Mid(So, 9, 1), mot1, "hai", "ba", bon, nam, sau, bay, tam, chin) _
                            & " " & tram
End If
ReadNum = doctramtrieu & " " & ReadNum
If Len(So) = 9 Then GoTo Tiep

docty = IIf(Val(Mid(So, 10, 1)) = 0 And Val(Mid(So, 11, 1)) > 0, ty, IIf(Val(Mid(So, 10, 1)) = 0, "", _
            Choose(Mid(So, 10, 1), IIf(Val(Mid(So, 11, 1)) > 1, mot2, mot1), "hai", "ba", bon, _
            IIf(Val(Mid(So, 11, 1)) = 0, nam, lam), sau, bay, tam, chin) & " " & ty))
ReadNum = docty & ", " & ReadNum
If Len(So) = 10 Then GoTo Tiep

If Val(Mid(So, 11, 1)) = 0 Then
    docchucty = IIf(Val(Mid(So, 10, 1)) > 0 And Len(So) > 11, le, "")
Else
    docchucty = Choose(Mid(So, 11, 1), muoi1, "hai", "ba", bon, nam, sau, bay, tam, chin)
    docchucty = IIf(docchucty = muoi1, muoi1, docchucty & " " & muoi2)
End If
ReadNum = docchucty & " " & ReadNum
If Len(So) = 11 Then GoTo Tiep

doctramty = Choose(Right(So, 1), mot1, "hai", "ba", bon, nam, sau, bay, tam, chin) & " " & _
                    IIf(Mid(So, 10, 2) = "00", tram & " " & ty, tram)
ReadNum = Replace(am & doctramty & " " & ReadNum, "  ", " ")
Tiep:
ReadNum = Replace(Replace(WorksheetFunction.Trim(ReadNum), ", , ,", ", "), ", ,", ", ")
ReadNum = WorksheetFunction.Trim(UCase(Left(ReadNum, 1)) & Mid(ReadNum, 2, 1000)) & IIf(loai, dong, ".")
End Function

 

[rollover79]

Hình như nó không đọc được số "0" thì phải...

 

[Nguyễn Duy Tuân]

Mình thử cho đọc số 1024.24 thì hàm đọc là "Một trăm lẻ hai nghìn bốn trăm hai mươi bốn" ?
Có lẽ nó đang bị sai với số có phần thập phân?

 

[hoangdanh282vn]

Mình đã chỉnh sửa lỗi và update lại file mới ở bài #1.

 

[Lệnh Hồ Đại Hiệp]

Sao không phải là 3 cái UDF nhỏ (đã có rất nhiều trên GPE) , sau đó có 1 cái UDF lớn hơn nhằm gọi 3 cái UDF kia tùy vào tham số tên Font đó.

Nhưng dù sao công tác giả nghiên cứu cũng rất đáng khích lệ

--CV--

 

[ptmyly]

Làm thế nào để thêm chữ đồng vào sau cùng à? Chỉ hộ e với, em cảm ơn

 

[tedaynui]

Làm thế nào để thêm chữ đồng vào sau cùng à? Chỉ hộ e với, em cảm ơn

Ví dụ : =ReadNum(A5)&" đồng"

TDN

 

[ptmyly]

Ví dụ : =ReadNum(A5)&" đồng"

TDN

Em làm thử theo bác rồi nhưng ko được

 

[thaycung]

đọc chữ thành số

Tôi không hiểu về lập trình, có sưu tầm được đoạn code để đọc chữ thành số trong excel, nhưng không chạy được. Nhờ mọi người kiểm tra và sửa giúp. Xin cảm ơn!

[FONT=&quot]Function CHUSO(so As Double) As String
Dim Chu As String, solop As Integer, so1 As Double, tg As Double
If so <= 0 Or so = Null Then
CHUSO = ""
End If
ReDim term(10) As String, lop(6) As Double, tlop(6) As String
term(1) = " mét"
term(2) = " hai"
term(3) = " ba"
term(4) = " bèn"
term(5) = " n¨m"
term(6) = " s¸u"
term(7) = " bÈy"
term(8) = " t¸m"
term(9) = " chÝn"
'-------------------
tlop(1) = ""
tlop(2) = " ngµn"
tlop(3) = " triÖu"
tlop(4) = " tû"
tlop(5) = " ngµn tû"
'----------------
so1 = so
solop = 1
Do While so1 > 0
tg = so1
so1 = Int(so1 / 1000)
lop(solop) = tg - so1 * 1000
solop = solop + 1
Loop
i = solop - 1
Chu = ""
Do While i > 0
so1 = lop(i)
If so1 > 0 Then
hangtram = so1 100
hangchuc = (so1 - hangtram * 100) 10
hangdonvi = so1 - (so1 10) * 10
If hangtram > 0 Then
'Chu so hang tram c¢ nghªa so1>=100
Chu = Chu + term(hangtram) + " tr¨m"
End If
'Xet chu so hang chuc
If hangchuc > 1 Then
Chu = Chu + term(hangchuc) + " m­¬i"
ElseIf hangchuc = 1 Then
Chu = Chu + " m­êi"
ElseIf hangchuc = 0 And so1 > 100 And hangdonvi <> 0 Then
Chu = Chu + " linh"
End If
' Xet ch§ s– h…ng ­ón v«
If hangdonvi <> 5 And hangdonvi <> 0 Then
Chu = Chu + term(hangdonvi)
ElseIf hangdonvi = 5 And hangchuc <> 0 Then
Chu = Chu + " l¨m "
ElseIf hangdonvi = 5 And hangchuc = 0 Then
Chu = Chu + " n¨m "
End If
Chu = Chu + tlop(i)
End If
' Xet lop ke tiep
i = i - 1
Loop
Chu = Trim(Chu)
If Chu <> "" Then
Chu = UCase(Left(Chu, 1)) & Right(Chu, Len(Chu) - 1)
End If
CHUSO = Chu
End Function

[/FONT] [FONT=&quot](Ghi chú: chữ một hai ba bốn ... trên với mã Font TCVN, bạn có thể đổi lại theo yêu cầu)

[/FONT]

 

[hoangdanh282vn]

Làm thế nào để thêm chữ đồng vào sau cùng à? Chỉ hộ e với, em cảm ơn

Mình đã Update phiên bản mới, có tùy chọn để thêm chữ "đồng" cuối câu và thêm dấu phẩy ngắt câu cho dễ nhìn.

 

[phamduylong]

Tôi đã viết lại hàm đọc số cho Unicode, hàm viết ngắn gọn hơn. Cho phép người dùng chọn cách đọc phù hợp.
Các bạn biết VBA có thể chỉnh lại để sử dụng cho VNI Windows, TCVN3.
Function DocSo(Number, DonVi, Le, Phay, Hoa)
Ý nghĩa các tham số:
Number: bắt buộc nhập, là số hoặc chuỗi có dạng số.
DonVi: không bắt buộc. Ngầm định không có đơn vị. DonVi nhập dạng chuỗi.
Le: không bắt buộc nhập. Ngầm định cách đọc "lẻ". Le nhập dạng chuỗi.
Phay: không bắt buộc nhập. Ngầm định không có dấu tách nhóm. Phay nhập dạng chuỗi.
Hoa: không bắt buộc nhập. Ngầm định viết hoa ký tự đầu tiên. Hoa nhập dạng Boolean:
_____________- TRUE hoặc số nguyên <>0: viết hoa ký tự đầu
_____________- FALSE hoặc 0: không viết hoa ký tự đầu.
Xem chi tiết tại chủ đề Hàm chuyển số thành chữ, bài 58 và 59 Hàm đọc số với các tham số theo yêu cầu người dùng

 

[phucbi56]

File nào có Update phiên bản mới vậy bạn?

 

[ninhtom1]

Mình đã Update phiên bản mới, có tùy chọn để thêm chữ "đồng" cuối câu và thêm dấu phẩy ngắt câu cho dễ nhìn.

Làm thế nào để bỏ cái dấu phẩy đi vậy bạn, nhìn nó ngắt ra bằng dấu phẩy thấy dở quá. Xin cảm ơn

 

[phucbi56]

Mình nhất trí với ý kiến của bạn ninhtom1