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

  • Thread starter hoangdanh282vn
  • Ngày gửi
H

hoangdanh282vn

Trung cấp
31/3/07
75
6
0
TP.HCM
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,"uni"), ReadNum(So) : Dùng cho Font Unicode - Mặc định
ReadNum(So,"vni") : Dùng cho Font VniTime
ReadNum(So,"tcv") : Dùng cho Font Tcvn3


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
 

Đính kèm

  • ReadNum.xls
    87.5 KB · Lượt xem: 637
Sửa lần cuối:
Khóa học Quản trị dòng tiền
N

newgate

Guest
7/1/09
3
0
0
45
Hà nôi
Cám ơn!

Cám ơn bạn "hoangdanh282vn"

"readnum" bạn gửi rất hay, nếu bạn ở HN thì mời bạn đi uống caphê nhé!!! (hoangsid@gmail.com)
 
T

THANHHIEU99

Guest
27/8/09
16
0
1
32
Cần Thơ
Cảm ơn bạn nhé, trước giờ mình dùng Vnutils và for_acc. Excel dùng font times new Roman, dịch số thành chữ phải chuyển về font VNI. Giờ thì ổn rùi.
 
H

hungpa

Sơ cấp
9/9/09
9
0
0
Son La
Cái này hay đấy, nhưng bro thêm chữ đồng vào đằng sau để đỡ phải dùng thêm công thức & chuỗi khi dùng.
 
H

hoangdanh282vn

Trung cấp
31/3/07
75
6
0
TP.HCM
Cái này hay đấy, nhưng bro thêm chữ đồng vào đằng sau để đỡ phải dùng thêm công thức & chuỗi khi dùng.

Mình đã update code ở bài #1. Có thêm tùy chọn để hiện thị chữ "đồng".
 
H

hoangdanh282vn

Trung cấp
31/3/07
75
6
0
TP.HCM
Không hiểu sao mình load về, mở ra sử dụng ngon lành rồi.
Nhưng khi tắt đi bật lại kết quả cho ra là #N/A.
Vào Insert\ Funtion\ Book1.xls !Module 1.ReadNum
Hàm ReadNum giờ ĐÂY BIẾN THÀNH Book1.xls !Module 1.ReadNum
bẠN NÀO GẶP NHƯ MÌNH CHƯA?

Bạn gửi file bị lỗi của bạn lên đây hoặc gửi vào mail cho mình, mình sẽ xem giúp bạn nha.
mail : hoangdanh282vn@yahoo.com
 
N

nvlong82

Guest
19/3/09
22
1
3
41
thanh hoá
Các bác có thể hướng dẫn em chi tiết cách dùng như thế nào không ạh. Em chưa dùng bao giờ nên khôg biết.
 

Xem nhiều

Webketoan Zalo OA