Sửa code chuyển số tiền thành số.

Liên hệ QC

tranhthurac

Thành viên mới
Tham gia
6/10/16
Bài viết
35
Được thích
3
Code hiện tại: Khi có số tiền 1.002.013.015 đồng, khi chuyển sang chữ sẽ có kết quả là Một tỷ, hai triệu, mười ba ngàn, mười lăm đồng chẵn; nhờ các bác sửa đoạn code đính kèm giúp để cho ra kết quả bằng chữ mong muốn như sau: Một tỷ, không trăm lẻ hai triệu, không trăm mười ba ngàn, không trăm mười lăm đồng chẵn.
Cảm ơn các bác.
Mã:
Function UnicodeChar(UniCharCode As String) As String
On Error GoTo Loi
Dim str
Dim desStr As String
Dim I
If Mid(UniCharCode, 1, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 2)
End If
If Right(UniCharCode, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 1, Len(UniCharCode) - 1)
End If
str = UniCharCode
str = Split(str, ";")
For I = LBound(str) To UBound(str)
desStr = desStr & ChrW$("&H" & str(I))
Next
UnicodeChar = desStr
Loi:
Exit Function
End Function

Function vnd(ByVal NumCurrency As Currency) As String
Static CharVND(9) As String, BangChu As String, I As Integer
Dim SoLe, SoDoi As Integer, PhanChan, Ten As String
Dim DonViTien As String, DonViLe As String
Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer
Dim Dong As Integer, Tram As Integer, Muoi As Integer, DonVi As Integer
NumCurrency = Round(NumCurrency, 0)
DonViTien = ";111;1ED3;6E;67" ' d?ng
DonViLe = ";78;75" ' xu
If NumCurrency = 0 Then
vnd = UnicodeChar(";4B;68;F4;6E;67;20" & DonViTien)
Exit Function
End If
If NumCurrency > 922337203685477# Then ' S? l?n nh?t c?a lo?i CURRENCY
vnd = UnicodeChar(";4B;68;F4;6E;67;20;111;1ED5;69;20;111;1B0;1EE3;63;20;73" & _
";1ED1;20;6C;1EDB;6E;20;68;1A1;6E;20;39;32;32;2C;33;33;37" & _
";2C;32;30;33;2C;36;38;35;2C;34;37;37")
Exit Function
End If
CharVND(1) = ";6D;1ED9;74" ' m?t
CharVND(2) = ";68;61;69" ' hai
CharVND(3) = ";62;61" ' ba
CharVND(4) = ";62;1ED1;6E" ' b?n
CharVND(5) = ";6E;103;6D" ' nam
CharVND(6) = ";73;E1;75" ' sáu
CharVND(7) = ";62;1EA3;79" ' b?y
CharVND(8) = ";74;E1;6D" ' tám
CharVND(9) = ";63;68;ED;6E" ' chín
SoLe = Int((NumCurrency - Int(NumCurrency)) * 100) ' 2 kí s?
PhanChan = Trim$(str$(Int(NumCurrency)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan
NganTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Ngan = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
If NganTy = 0 And Ty = 0 And Trieu = 0 And Ngan = 0 And Dong = 0 Then
BangChu = ";6B;68;F4;6E;67;20" + DonViTien + ";20"
I = 5
Else
BangChu = ""
I = 0
End If
'-----------------------------------------------------
' B?t d?u d?i
'-----------------------------------------------------
While I <= 5
Select Case I
Case 0
SoDoi = NganTy
Ten = ";6E;67;E0;6E;20;74;1EF7" ' ngàn t?
Case 1
SoDoi = Ty
Ten = ";74;1EF7" ' t?
Case 2
SoDoi = Trieu
Ten = ";74;72;69;1EC7;75" ' tri?u
Case 3
SoDoi = Ngan
Ten = ";6E;67;E0;6E" ' ngàn
Case 4
SoDoi = Dong
Ten = DonViTien ' d?ng
Case 5
SoDoi = SoLe
Ten = DonViLe ' xu
End Select
If SoDoi <> 0 Then
Tram = Int(SoDoi / 100)
Muoi = Int((SoDoi - Tram * 100) / 10)
DonVi = (SoDoi - Tram * 100) - Muoi * 10
If Right(BangChu, 3) = ";20" Then
BangChu = Left(BangChu, Len(BangChu) - 3)
End If
BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";2C;20") + _
IIf(Tram <> 0, Trim(CharVND(Tram)) + ";20;74;72;103;6D;20", "")
If Muoi = 0 And Tram <> 0 And DonVi <> 0 Then
BangChu = BangChu + ";6C;1EBB;20"
Else
If Muoi <> 0 Then
BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, _
Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20")
End If
End If
If Muoi <> 0 And DonVi = 5 Then
BangChu = BangChu + ";6C;103;6D;20" + Ten + ";20"
Else
If Muoi > 1 And DonVi = 1 Then
BangChu = BangChu + ";6D;1ED1;74;20" + Ten + ";20"
Else
BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten) + ";20"
End If
End If
Else
BangChu = BangChu + IIf(I = 4, DonViTien + "", "")
End If
I = I + 1
Wend
If SoLe = 0 Then
BangChu = BangChu + IIf(Right(BangChu, 3) = ";20", "", ";20") + ";63;68;1EB5;6E"
End If
BangChu = UnicodeChar(BangChu)
'Ð?i sang ti?ng Vi?t Unicode
' Ð?i ch? cái d?u tiên thành ch? hoa
Mid$(BangChu, 1, 1) = UCase$(Mid$(BangChu, 1, 1))
vnd = BangChu
End Function
 
Lần chỉnh sửa cuối:
Code đọc số có cả đống rồi. Chịu khó tìm ra thấy cái mình cần thôi.
 
Hình như tiêu đề và nội dung đối lập nhau. @@

1607652487492.png
 
Hàm mình đang dùng tên là ReadVN để đọc tiếng Việt, còn readEN để đọc tiếng Anh
 

File đính kèm

  • Test.xlsm
    43.3 KB · Đọc: 18
Hình như tiêu đề và nội dung đối lập nhau. @@

View attachment 251010
Code chưa chuyển thành tiền theo mong muốn, nên nhờ các bác sửa giúp, không hiểu ý bác ntn
Bài đã được tự động gộp:

Hàm mình đang dùng tên là ReadVN để đọc tiếng Việt, còn readEN để đọc tiếng Anh
Cảm ơn bác, để mình thử.
 
Thử nhé bạn!
PHP:
Function VND(ByVal Numcurrency As Currency) As String
Static CharVND(9) As String, BangChu As String, i As Integer, k As Integer
Dim SoDoi As Integer, PhanChan, Ten, Seri, Char As String
Dim DonViTien As String, DonViLe As String
Dim NghinTy As Integer, Ty As Integer, Trieu As Integer, Nghin As Integer
Dim Dong As Integer, Tram As Integer, Muoi As Integer, DonVi As Integer
DonViTien = ";111;1ED3;6E;67;2E" ' d?ng
Numcurrency = Round(Numcurrency, 0)
If Numcurrency = 0 Then
VND = UnicodeChar(";42;1eb1;6e;67;20;63;68;1eef;3A;20;4B;68;F4;6E;67;20" & DonViTien)
Exit Function
End If
If Numcurrency > 922337203685477# Then ' S? l?n nh?t c?a lo?i CURRENCY
VND = UnicodeChar(";4B;68;F4;6E;67;20;111;1ED5;69;20;111;1B0;1EE3;63;20;73" & _
";1ED1;20;6C;1EDB;6E;20;68;1A1;6E;20;39;32;32;2C;33;33;37" & _
";2C;32;30;33;2C;36;38;35;2C;34;37;37;EC;1eef;1eb1;e2")
Exit Function
End If
CharVND(1) = ";6D;1ED9;74" ' m?t
CharVND(2) = ";68;61;69" ' hai
CharVND(3) = ";62;61" ' ba
CharVND(4) = ";62;1ED1;6E" ' b?n
CharVND(5) = ";6E;103;6D" ' nam
CharVND(6) = ";73;E1;75" ' sáu
CharVND(7) = ";62;1EA3;79" ' b?y
CharVND(8) = ";74;E1;6D" ' tám
CharVND(9) = ";63;68;ED;6E" ' chín

PhanChan = Trim$(Str$(Int(Numcurrency)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan
NghinTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Nghin = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
If NghinTy = 0 And Ty = 0 And Trieu = 0 And Nghin = 0 And Dong = 0 Then
BangChu = ";6B;68;F4;6E;67;20" + DonViTien + ";20"
i = 5
Else
BangChu = ""
i = 0
End If
'-----------------------------------------------------
' B?t d?u d?i
'-----------------------------------------------------
BangChu = ";42;1eb1;6e;67;20;63;68;1eef;3A"
If Numcurrency < 0 Then BangChu = ";42;1eb1;6e;67;20;63;68;1eef;3A;20;C2;6D"
k = 0
While i <= 4
Select Case i
Case 0
If NghinTy > 0 And Ty = 0 And Trieu = 0 And Nghin = 0 And Dong = 0 Then
    SoDoi = NghinTy
    Ten = ";6E;67;68;EC;6E;20;74;1EF7" ' nghìn t?
Else
    SoDoi = NghinTy
    Ten = ";6E;67;68;EC;6E;20;74;1EF7;2C" ' nghìn t?
End If
Case 1
If Ty > 0 And Trieu = 0 And Nghin = 0 And Dong = 0 Then
    SoDoi = Ty
    Ten = ";74;1EF7" ' t?
Else
    SoDoi = Ty
    Ten = ";74;1EF7;2C"
End If
Case 2
If Trieu > 0 And Nghin = 0 And Dong = 0 Then
    SoDoi = Trieu
    Ten = ";74;72;69;1EC7;75" ' tri?u
Else
    SoDoi = Trieu
    Ten = ";74;72;69;1EC7;75;2C"
End If
Case 3
If Nghin > 0 And Dong = 0 Then
    SoDoi = Nghin
    Ten = ";6E;67;68;EC;6E" ' nghìn
Else
    SoDoi = Nghin
    Ten = ";6E;67;68;EC;6E;2C" ' nghìn
End If
Case 4
SoDoi = Dong
Ten = DonViTien ' d?ng
End Select
If SoDoi < 0 Then
SoDoi = 0 - SoDoi
BangChu = BangChu + ";20;e2;6d"
End If
If SoDoi = 0 Then
 k = k + 1
End If
If SoDoi <> 0 Then
 Tram = Int(SoDoi / 100)
 Muoi = Int((SoDoi - Tram * 100) / 10)
 DonVi = (SoDoi - Tram * 100) - Muoi * 10
 If Right(BangChu, 3) = ";20" Then
 BangChu = Left(BangChu, Len(BangChu) - 3)
 End If
 If Tram = 0 And k <> i Then
    BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";20") + ";6B;68;F4;6e;67;20;74;72;103;6D;20"
    If Muoi = 0 And DonVi <> 0 Then
       BangChu = BangChu + ";6C;69;6E;68;20"
    Else
       If Muoi <> 0 Then
          BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20")
       End If
    End If
    If Muoi <> 0 And DonVi = 5 Then
       BangChu = BangChu + ";6C;103;6D;20" + Ten + ";20"
    Else
       If Muoi > 1 And DonVi = 1 Then
          BangChu = BangChu + ";6D;1ED1;74;20" + Ten + ";20"
       Else
          BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten) + ";20"
       End If
    End If
 Else
 BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";20") + IIf(Tram <> 0, Trim(CharVND(Tram)) + ";20;74;72;103;6D;20", "")
    If Muoi = 0 And Tram <> 0 And DonVi <> 0 Then
       BangChu = BangChu + ";6C;69;6E;68;20"
    Else
       If Muoi <> 0 Then
          BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20")
       End If
    End If
    If Muoi <> 0 And DonVi = 5 Then
       BangChu = BangChu + ";6C;103;6D;20" + Ten + ";20"
    Else
       If Muoi > 1 And DonVi = 1 Then
          BangChu = BangChu + ";6D;1ED1;74;20" + Ten + ";20"
       Else
          BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten) + ";20"
       End If
    End If
    End If
Else
BangChu = BangChu + IIf(i = 4, DonViTien + "", "")
End If
i = i + 1
Wend
BangChu = BangChu + IIf(Right(BangChu, 3) = ";20", "", ";20")
BangChu = Replace(BangChu, ";6C;69;6E;68;20;62;1ED1;6E", ";6C;69;6E;68;20;74;1B0")
BangChu = Replace(BangChu, ";6D;1B0;1A1;69;20;62;1ED1;6E", ";6D;1B0;1A1;69;20;74;1B0")
BangChu = UnicodeChar(BangChu)
'Ð?i sang ti?ng Vi?t Unicode
' Ð?i ch? cái d?u tiên thành ch? hoa
Mid$(BangChu, 11, 1) = UCase$(Mid$(BangChu, 11, 1))
VND = BangChu
End Function
 
1/ Tiêu đề bài viết không ohù hợp với nội dung, đúng ra Tiêu đề phải là "Giúp sửa code đọc số tiền bằng chữ".
2/ Nội quy, quy định "Bài viết bằng tiếng Việt cần viết có dấu đầy đủ, tránh phạm lỗi chính tả". Vì vậy, bạn không nên viết tắt thế này "ntn".
Xin lỗi bạn, cảm ơn bạn đã nhắc nhỡ.
Bài đã được tự động gộp:

Thử nhé bạn!
PHP:
Function VND(ByVal Numcurrency As Currency) As String
Static CharVND(9) As String, BangChu As String, i As Integer, k As Integer
Dim SoDoi As Integer, PhanChan, Ten, Seri, Char As String
Dim DonViTien As String, DonViLe As String
Dim NghinTy As Integer, Ty As Integer, Trieu As Integer, Nghin As Integer
Dim Dong As Integer, Tram As Integer, Muoi As Integer, DonVi As Integer
DonViTien = ";111;1ED3;6E;67;2E" ' d?ng
Numcurrency = Round(Numcurrency, 0)
If Numcurrency = 0 Then
VND = UnicodeChar(";42;1eb1;6e;67;20;63;68;1eef;3A;20;4B;68;F4;6E;67;20" & DonViTien)
Exit Function
End If
If Numcurrency > 922337203685477# Then ' S? l?n nh?t c?a lo?i CURRENCY
VND = UnicodeChar(";4B;68;F4;6E;67;20;111;1ED5;69;20;111;1B0;1EE3;63;20;73" & _
";1ED1;20;6C;1EDB;6E;20;68;1A1;6E;20;39;32;32;2C;33;33;37" & _
";2C;32;30;33;2C;36;38;35;2C;34;37;37;EC;1eef;1eb1;e2")
Exit Function
End If
CharVND(1) = ";6D;1ED9;74" ' m?t
CharVND(2) = ";68;61;69" ' hai
CharVND(3) = ";62;61" ' ba
CharVND(4) = ";62;1ED1;6E" ' b?n
CharVND(5) = ";6E;103;6D" ' nam
CharVND(6) = ";73;E1;75" ' sáu
CharVND(7) = ";62;1EA3;79" ' b?y
CharVND(8) = ";74;E1;6D" ' tám
CharVND(9) = ";63;68;ED;6E" ' chín

PhanChan = Trim$(Str$(Int(Numcurrency)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan
NghinTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Nghin = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
If NghinTy = 0 And Ty = 0 And Trieu = 0 And Nghin = 0 And Dong = 0 Then
BangChu = ";6B;68;F4;6E;67;20" + DonViTien + ";20"
i = 5
Else
BangChu = ""
i = 0
End If
'-----------------------------------------------------
' B?t d?u d?i
'-----------------------------------------------------
BangChu = ";42;1eb1;6e;67;20;63;68;1eef;3A"
If Numcurrency < 0 Then BangChu = ";42;1eb1;6e;67;20;63;68;1eef;3A;20;C2;6D"
k = 0
While i <= 4
Select Case i
Case 0
If NghinTy > 0 And Ty = 0 And Trieu = 0 And Nghin = 0 And Dong = 0 Then
    SoDoi = NghinTy
    Ten = ";6E;67;68;EC;6E;20;74;1EF7" ' nghìn t?
Else
    SoDoi = NghinTy
    Ten = ";6E;67;68;EC;6E;20;74;1EF7;2C" ' nghìn t?
End If
Case 1
If Ty > 0 And Trieu = 0 And Nghin = 0 And Dong = 0 Then
    SoDoi = Ty
    Ten = ";74;1EF7" ' t?
Else
    SoDoi = Ty
    Ten = ";74;1EF7;2C"
End If
Case 2
If Trieu > 0 And Nghin = 0 And Dong = 0 Then
    SoDoi = Trieu
    Ten = ";74;72;69;1EC7;75" ' tri?u
Else
    SoDoi = Trieu
    Ten = ";74;72;69;1EC7;75;2C"
End If
Case 3
If Nghin > 0 And Dong = 0 Then
    SoDoi = Nghin
    Ten = ";6E;67;68;EC;6E" ' nghìn
Else
    SoDoi = Nghin
    Ten = ";6E;67;68;EC;6E;2C" ' nghìn
End If
Case 4
SoDoi = Dong
Ten = DonViTien ' d?ng
End Select
If SoDoi < 0 Then
SoDoi = 0 - SoDoi
BangChu = BangChu + ";20;e2;6d"
End If
If SoDoi = 0 Then
k = k + 1
End If
If SoDoi <> 0 Then
Tram = Int(SoDoi / 100)
Muoi = Int((SoDoi - Tram * 100) / 10)
DonVi = (SoDoi - Tram * 100) - Muoi * 10
If Right(BangChu, 3) = ";20" Then
BangChu = Left(BangChu, Len(BangChu) - 3)
End If
If Tram = 0 And k <> i Then
    BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";20") + ";6B;68;F4;6e;67;20;74;72;103;6D;20"
    If Muoi = 0 And DonVi <> 0 Then
       BangChu = BangChu + ";6C;69;6E;68;20"
    Else
       If Muoi <> 0 Then
          BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20")
       End If
    End If
    If Muoi <> 0 And DonVi = 5 Then
       BangChu = BangChu + ";6C;103;6D;20" + Ten + ";20"
    Else
       If Muoi > 1 And DonVi = 1 Then
          BangChu = BangChu + ";6D;1ED1;74;20" + Ten + ";20"
       Else
          BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten) + ";20"
       End If
    End If
Else
BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";20") + IIf(Tram <> 0, Trim(CharVND(Tram)) + ";20;74;72;103;6D;20", "")
    If Muoi = 0 And Tram <> 0 And DonVi <> 0 Then
       BangChu = BangChu + ";6C;69;6E;68;20"
    Else
       If Muoi <> 0 Then
          BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20")
       End If
    End If
    If Muoi <> 0 And DonVi = 5 Then
       BangChu = BangChu + ";6C;103;6D;20" + Ten + ";20"
    Else
       If Muoi > 1 And DonVi = 1 Then
          BangChu = BangChu + ";6D;1ED1;74;20" + Ten + ";20"
       Else
          BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten) + ";20"
       End If
    End If
    End If
Else
BangChu = BangChu + IIf(i = 4, DonViTien + "", "")
End If
i = i + 1
Wend
BangChu = BangChu + IIf(Right(BangChu, 3) = ";20", "", ";20")
BangChu = Replace(BangChu, ";6C;69;6E;68;20;62;1ED1;6E", ";6C;69;6E;68;20;74;1B0")
BangChu = Replace(BangChu, ";6D;1B0;1A1;69;20;62;1ED1;6E", ";6D;1B0;1A1;69;20;74;1B0")
BangChu = UnicodeChar(BangChu)
'Ð?i sang ti?ng Vi?t Unicode
' Ð?i ch? cái d?u tiên thành ch? hoa
Mid$(BangChu, 11, 1) = UCase$(Mid$(BangChu, 11, 1))
VND = BangChu
End Function
1607769772770.png
Không hiểu bị lỗi gì bạn à, mình không chạy được.
Bài đã được tự động gộp:

Hàm mình đang dùng tên là ReadVN để đọc tiếng Việt, còn readEN để đọc tiếng Anh
Cảm ơn bạn, cái này mình đang tìm.
 
Lần chỉnh sửa cuối:
Hàm mình đang dùng tên là ReadVN để đọc tiếng Việt, còn readEN để đọc tiếng Anh
File của bác mình có mò sửa được lỗi chữ số "Bẩy" thành "Bảy", và trước chữ "lẽ" có hai khoảng cách, mình sửa lại 1 khoảng cách (một trăn lẻ -> một trăm lẻ).
Hiện tại có lỗi không viết hoa chữ đầu được - nếu chữ đó bắt đầu chữ "Một", còn các chữ khác thì viết hoa được. Và phần đuôi nếu muốn thêm chữ "đồng." thì mình phải thêm tay chứ hàm này chưa có.
Nếu được nhờ bác bổ sửa giúp.
Cảm ơn bác.
 

File đính kèm

  • Test - VND.xlsm
    46.5 KB · Đọc: 6
Sao mấy bạn làm bên mua chỗ mình không phát hiện chữ "lẻ" bị sai dấu cách nhỉ
 

File đính kèm

  • Test - VND.xlsm
    44.3 KB · Đọc: 8
Sao mấy bạn làm bên mua chỗ mình không phát hiện chữ "lẻ" bị sai dấu cách nhỉ
Cảm ơn bác nhiều nhé, em nó đã có được đoạn code đúng theo mong muốn.
Chắc tại em nó đang thất nghiệp, nên có nhiều thời gian để soi cái lỗi khi đi xin tài liệu bạc ạ :(
 
Cảm ơn bác nhiều nhé, em nó đã có được đoạn code đúng theo mong muốn.
Chắc tại em nó đang thất nghiệp, nên có nhiều thời gian để soi cái lỗi khi đi xin tài liệu bạc ạ :(
Con số 612.545.001.057.005 đồng thì code đã chỉnh sửa của bạn đọc ra sao?
Nếu không đọc được thành: Sáu trăm mười hai ngàn, năm trăm bốn mươi lăm tỷ, không trăm lẻ một triệu, không trăm năm mươi bảy ngàn, không trăm lẻ năm đồng chẵn. thì bạn cần xem lại!
 
Con số 612.545.001.057.005 đồng thì code đã chỉnh sửa của bạn đọc ra sao?
Nếu không đọc được thành: Sáu trăm mười hai ngàn, năm trăm bốn mươi lăm tỷ, không trăm lẻ một triệu, không trăm năm mươi bảy ngàn, không trăm lẻ năm đồng chẵn. thì bạn cần xem lại!
Cuối code Replace cái đoạn "ngàn tỷ," thành "ngàn" là ok thôi.
 
Con số 612.545.001.057.005 đồng thì code đã chỉnh sửa của bạn đọc ra sao?
Nếu không đọc được thành: Sáu trăm mười hai ngàn, năm trăm bốn mươi lăm tỷ, không trăm lẻ một triệu, không trăm năm mươi bảy ngàn, không trăm lẻ năm đồng chẵn. thì bạn cần xem lại!
Em không có làm dự án lớn tới con số đấy bao giờ nên chưa kiểm tra bác ạ.
Cuối code Replace cái đoạn "ngàn tỷ," thành "ngàn" là ok thôi.
Cảm ơn bác đã chỉ cách chỉnh sửa.
Vì sợ đặt tên hàm trùng với cài đặt trong Excel của người khác, nên mình đặt tên hàm mới "hpvnd" để không trùng với bất kỳ máy nào. Mình có thể nói là không biết viết gì về macro, cái này là của bác Đệp Zai :) cho, mình chỉ sửa lại theo ý mình một chút mà thôi.
Mã:
Option Explicit
'***************************************************************************************************
'' Author: Ngoc Hoang - GiaiphapExcel.com
'' Version: V.1.1 - 01/11/2015
'***************************************************************************************************

Function UniConvert(text As String, InputMethod As String) As String
  Dim VNI_Type, Telex_Type, CharCode, Temp, i As Long
  UniConvert = text
  VNI_Type = Array("a81", "a82", "a83", "a84", "a85", "a61", "a62", "a63", "a64", "a65", "e61", _
      "e62", "e63", "e64", "e65", "o61", "o62", "o63", "o64", "o65", "o71", "o72", "o73", "o74", _
      "o75", "u71", "u72", "u73", "u74", "u75", "a1", "a2", "a3", "a4", "a5", "a8", "a6", "d9", _
      "e1", "e2", "e3", "e4", "e5", "e6", "i1", "i2", "i3", "i4", "i5", "o1", "o2", "o3", "o4", _
      "o5", "o6", "o7", "u1", "u2", "u3", "u4", "u5", "u7", "y1", "y2", "y3", "y4", "y5")
  Telex_Type = Array("aws", "awf", "awr", "awx", "awj", "aas", "aaf", "aar", "aax", "aaj", "ees", _
      "eef", "eer", "eex", "eej", "oos", "oof", "oor", "oox", "ooj", "ows", "owf", "owr", "owx", _
      "owj", "uws", "uwf", "uwr", "uwx", "uwj", "as", "af", "ar", "ax", "aj", "aw", "aa", "dd", _
      "es", "ef", "er", "ex", "ej", "ee", "is", "if", "ir", "ix", "ij", "os", "of", "or", "ox", _
      "oj", "oo", "ow", "us", "uf", "ur", "ux", "uj", "uw", "ys", "yf", "yr", "yx", "yj")
  CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
      ChrW(7849), ChrW(7851), ChrW(7853), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
      ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), ChrW(7899), ChrW(7901), ChrW(7903), _
      ChrW(7905), ChrW(7907), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), ChrW(7921), ChrW(225), _
      ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), ChrW(259), ChrW(226), ChrW(273), ChrW(233), ChrW(232), _
      ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), ChrW(7881), ChrW(297), ChrW(7883), _
      ChrW(243), ChrW(242), ChrW(7887), ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(250), ChrW(249), _
      ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
  Select Case InputMethod
    Case Is = "VNI": Temp = VNI_Type
    Case Is = "Telex": Temp = Telex_Type
  End Select
  For i = 0 To UBound(CharCode)
    UniConvert = Replace(UniConvert, Temp(i), CharCode(i))
    UniConvert = Replace(UniConvert, UCase(Temp(i)), UCase(CharCode(i)))
  Next i
End Function

Function hpvnd(ByVal Series As String) As String
    Series = Replace(Series, " ", "")
    If Not IsNumeric(Series) Then Exit Function
    Dim IsNegative As Boolean
    If Left(Series, 1) = "-" Then
        IsNegative = True
        Series = Replace(Series, "-", "")
    End If
    If Series = "" Then Exit Function
    If Series = 0 Then hpvnd = UniConvert("Kho6ng.", "VNI"): Exit Function
    If Series >= 1E+15 Then hpvnd = "No result (huge number).": Exit Function
    Dim arrUnits, Deci As String, Digi As String
    arrUnits = DecimalSpelling(Series)
    Digi = arrUnits(0): Deci = arrUnits(1)
    Dim DigitString, SplitArr, SplitArray, Ubd As Long, i As Long, JoinArr(), n As Long
    DigitString = Array(UniConvert(" tra8m", "VNI"), UniConvert(" nga2n", "VNI"), UniConvert(" trie65u", "VNI"), UniConvert(" ty3", "VNI"), UniConvert(" nga2n", "VNI"))
    SplitArray = Split(Digi, ",")
    Ubd = UBound(SplitArray)
    ReDim SplitArr(0 To Ubd)
    For i = Ubd To 0 Step -1
        SplitArr(n) = SplitArray(i)
        n = n + 1
    Next
    Dim Itm As String: n = 0
    For i = Ubd To 0 Step -1
        Itm = SplitArr(i)
        If Itm > 0 Then
            If i = 0 Then
                ReDim Preserve JoinArr(0 To n)
                JoinArr(n) = Hundreds(Itm)
            Else
                ReDim Preserve JoinArr(0 To n)
                JoinArr(n) = Hundreds(Itm) & DigitString(i)
            End If
            n = n + 1
        End If
    Next
    Digi = Join(JoinArr, ", ")
    If IsNegative Then
        Digi = UniConvert("A6m ", "VNI") & Digi 'You can use "Negative" instead of "Minus"
    Else
        If Left(Digi, 4) = UniConvert("mo65t ", "VNI") Then
            Digi = Replace(Digi, UniConvert("mo65t ", "VNI"), UniConvert("Mo65t ", "VNI"), , 1)
        Else
            Digi = UCase(Left(Digi, 1)) & Mid(Digi, 2)
        End If
    End If
    hpvnd = Digi & Deci & UniConvert(" d9o62ng.", "VNI") '& "."
End Function
'***************************************************************************************************

''This is a supplemental function for 'hpvnd' function:
Private Function Hundreds(ByVal StrNum As String) As String
    Dim Units, LessThanTwenty, Tens, LessThanTen
    Units = Array(UniConvert("kho6ng", "VNI"), UniConvert("mo65t", "VNI"), "hai", "ba", UniConvert("bo61n", "VNI"), UniConvert("na8m", "VNI"), UniConvert("sa1u", "VNI"), UniConvert("ba3y", "VNI"), UniConvert("ta1m", "VNI"), UniConvert("chi1n", "VNI"))
    LessThanTwenty = Array(UniConvert("mu7o72i", "VNI"), UniConvert("mu7o72i mo65t", "VNI"), UniConvert("mu7o72i hai", "VNI"), UniConvert("mu7o72i ba", "VNI"), UniConvert("mu7o72i bo61n", "VNI"), UniConvert("mu7o72i na8m", "VNI"), UniConvert("mu7o72i sa1u", "VNI"), _
                           UniConvert("mu7o72i ba3y", "VNI"), UniConvert("mu7o72i ta1m", "VNI"), UniConvert("mu7o72i chi1n", "VNI"))
    LessThanTen = Array(UniConvert("le3 mo65t", "VNI"), UniConvert("le3 hai", "VNI"), UniConvert("le3 ba", "VNI"), UniConvert("le3 bo61n", "VNI"), UniConvert("le3 na8m", "VNI"), UniConvert("le3 sa1u", "VNI"), _
                           UniConvert("le3 ba3y", "VNI"), UniConvert("le3 ta1m", "VNI"), UniConvert("le3 chi1n", "VNI"))
    Tens = Array(UniConvert("mu7o72i", "VNI"), UniConvert("hai mu7o7i", "VNI"), UniConvert("ba mu7o7i", "VNI"), UniConvert("bo61n mu7o7i", "VNI"), UniConvert("na8m mu7o7i", "VNI"), UniConvert("sa1u mu7o7i", "VNI"), UniConvert("ba3y mu7o7i", "VNI"), UniConvert("ta1m mu7o7i", "VNI"), UniConvert("chi1n mu7o7i", "VNI"))
    Dim Len1 As String, Len2 As String, Len3 As String
    Select Case Len(StrNum)
    Case 1
        Hundreds = Units(StrNum)
    Case 2
        Select Case StrNum
        Case Is < 20
            Hundreds = LessThanTwenty(StrNum - 10)
        Case Else
            If StrNum Mod 10 = 0 Then
                Hundreds = Tens(StrNum / 10 - 1)
            Else
                Len1 = Right(StrNum, 1)
                Len2 = (StrNum - Len1) / 10 - 1
                Hundreds = Tens(Len2) & " " & Units(Len1)
            End If
        End Select
    Case Else
        Len3 = Left(StrNum, 1)
        Hundreds = Units(Len3) & UniConvert(" tra8m", "VNI")
        Len3 = Val(Right(StrNum, 2))
       
        If Len3 > 0 Then
            Dim Hdrs As String
            Select Case Len(Len3)
            Case 1
                Hdrs = UniConvert("le3 ", "VNI") & Units(Len3)
            Case 2
                'Select Case Len3
                 If Len3 < 10 Then
                 Hdrs = LessThanTen(Len3)
                 Else
                 If Len3 > 9 Then
                                 
                'Case Else
                    If StrNum Mod 10 = 0 Then
                        Hdrs = Tens(Len3 / 10 - 1)
                    Else
                        Len1 = Right(Len3, 1)
                        Len2 = (Len3 - Len1) / 10 - 1
                        Hdrs = Tens(Len2) & " " & Units(Len1)
                    End If
                End If
                End If
                'End Select
            End Select
            Hundreds = Hundreds & " " & Hdrs
        End If
    End Select
End Function
'***************************************************************************************************

''This is a supplemental function for 'hpvnd' function:
Private Function DecimalSpelling(ByVal Series As String) As Variant
    Dim DeciSpell(0 To 1)
    Dim Point As Long, Deci As String, Digi As String
    Point = InStr(Series, "."):  Digi = Series
    If Point = 0 Then
GoTo ExitFunction
    Else
        Deci = Mid(Series, Point)
        If Deci = 0 Then
GoTo ExitFunction
        Else
            Digi = Replace(Series, Deci, "")
            If Len(Deci) > 4 Then
                Deci = Format(Deci, "0.000")
                If Deci = 0 Then
GoTo ExitFunction
                ElseIf Deci = 1 Then
                    DeciSpell(0) = Format(Digi + 1, "#,##0")
                    DeciSpell(1) = ""
                    DecimalSpelling = DeciSpell
                    Exit Function
                Else
                    Deci = Replace(Deci, "0.", "")
                End If
            Else
                Deci = Replace(Deci, ".", "")
            End If
            Dim Units, arrUnits, Tens, i As Long, j As Long
            Units = Array(UniConvert("kho6ng", "VNI"), UniConvert("mo65t", "VNI"), " hai", "ba", UniConvert("bo61n", "VNI"), UniConvert("na8m", "VNI"), UniConvert("sa1u", "VNI"), UniConvert("ba3y", "VNI"), UniConvert("ta1m", "VNI"), UniConvert("chi1n", "VNI"))
            j = Len(Deci)
            ReDim arrUnits(1 To j)
            For i = 1 To j
                arrUnits(i) = Units(Mid(Deci, i, 1))
            Next
            DeciSpell(0) = Format(Digi, "#,##0")
            DeciSpell(1) = UniConvert(" pha63y ", "VNI") & Join(arrUnits, " ")
        End If
    End If
    DecimalSpelling = DeciSpell
    Exit Function
ExitFunction:
    DeciSpell(0) = Format(Digi, "#,##0")
    DeciSpell(1) = ""
    DecimalSpelling = DeciSpell
End Function
'***************************************************************************************************
 
Lần chỉnh sửa cuối:
Em không có làm dự án lớn tới con số đấy bao giờ nên chưa kiểm tra bác ạ.

Cảm ơn bác đã chỉ cách chỉnh sửa.
Vì sợ đặt tên hàm trùng với cài đặt trong Excel của người khác, nên mình đặt tên hàm mới "hpvnd" để không trùng với bất kỳ máy nào.
Mã:
Option Explicit
'***************************************************************************************************
'' Author: Ngoc Hoang - GiaiphapExcel.com
'' Version: V.1.1 - 01/11/2015
'***************************************************************************************************

Function UniConvert(text As String, InputMethod As String) As String
  Dim VNI_Type, Telex_Type, CharCode, Temp, i As Long
  UniConvert = text
  VNI_Type = Array("a81", "a82", "a83", "a84", "a85", "a61", "a62", "a63", "a64", "a65", "e61", _
      "e62", "e63", "e64", "e65", "o61", "o62", "o63", "o64", "o65", "o71", "o72", "o73", "o74", _
      "o75", "u71", "u72", "u73", "u74", "u75", "a1", "a2", "a3", "a4", "a5", "a8", "a6", "d9", _
      "e1", "e2", "e3", "e4", "e5", "e6", "i1", "i2", "i3", "i4", "i5", "o1", "o2", "o3", "o4", _
      "o5", "o6", "o7", "u1", "u2", "u3", "u4", "u5", "u7", "y1", "y2", "y3", "y4", "y5")
  Telex_Type = Array("aws", "awf", "awr", "awx", "awj", "aas", "aaf", "aar", "aax", "aaj", "ees", _
      "eef", "eer", "eex", "eej", "oos", "oof", "oor", "oox", "ooj", "ows", "owf", "owr", "owx", _
      "owj", "uws", "uwf", "uwr", "uwx", "uwj", "as", "af", "ar", "ax", "aj", "aw", "aa", "dd", _
      "es", "ef", "er", "ex", "ej", "ee", "is", "if", "ir", "ix", "ij", "os", "of", "or", "ox", _
      "oj", "oo", "ow", "us", "uf", "ur", "ux", "uj", "uw", "ys", "yf", "yr", "yx", "yj")
  CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
      ChrW(7849), ChrW(7851), ChrW(7853), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
      ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), ChrW(7899), ChrW(7901), ChrW(7903), _
      ChrW(7905), ChrW(7907), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), ChrW(7921), ChrW(225), _
      ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), ChrW(259), ChrW(226), ChrW(273), ChrW(233), ChrW(232), _
      ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), ChrW(7881), ChrW(297), ChrW(7883), _
      ChrW(243), ChrW(242), ChrW(7887), ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(250), ChrW(249), _
      ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
  Select Case InputMethod
    Case Is = "VNI": Temp = VNI_Type
    Case Is = "Telex": Temp = Telex_Type
  End Select
  For i = 0 To UBound(CharCode)
    UniConvert = Replace(UniConvert, Temp(i), CharCode(i))
    UniConvert = Replace(UniConvert, UCase(Temp(i)), UCase(CharCode(i)))
  Next i
End Function

Function hpvnd(ByVal Series As String) As String
    Series = Replace(Series, " ", "")
    If Not IsNumeric(Series) Then Exit Function
    Dim IsNegative As Boolean
    If Left(Series, 1) = "-" Then
        IsNegative = True
        Series = Replace(Series, "-", "")
    End If
    If Series = "" Then Exit Function
    If Series = 0 Then hpvnd = UniConvert("Kho6ng.", "VNI"): Exit Function
    If Series >= 1E+15 Then hpvnd = "No result (huge number).": Exit Function
    Dim arrUnits, Deci As String, Digi As String
    arrUnits = DecimalSpelling(Series)
    Digi = arrUnits(0): Deci = arrUnits(1)
    Dim DigitString, SplitArr, SplitArray, Ubd As Long, i As Long, JoinArr(), n As Long
    DigitString = Array(UniConvert(" tra8m", "VNI"), UniConvert(" nga2n", "VNI"), UniConvert(" trie65u", "VNI"), UniConvert(" ty3", "VNI"), UniConvert(" nga2n", "VNI"))
    SplitArray = Split(Digi, ",")
    Ubd = UBound(SplitArray)
    ReDim SplitArr(0 To Ubd)
    For i = Ubd To 0 Step -1
        SplitArr(n) = SplitArray(i)
        n = n + 1
    Next
    Dim Itm As String: n = 0
    For i = Ubd To 0 Step -1
        Itm = SplitArr(i)
        If Itm > 0 Then
            If i = 0 Then
                ReDim Preserve JoinArr(0 To n)
                JoinArr(n) = Hundreds(Itm)
            Else
                ReDim Preserve JoinArr(0 To n)
                JoinArr(n) = Hundreds(Itm) & DigitString(i)
            End If
            n = n + 1
        End If
    Next
    Digi = Join(JoinArr, ", ")
    If IsNegative Then
        Digi = UniConvert("A6m ", "VNI") & Digi 'You can use "Negative" instead of "Minus"
    Else
        If Left(Digi, 4) = UniConvert("mo65t ", "VNI") Then
            Digi = Replace(Digi, UniConvert("mo65t ", "VNI"), UniConvert("Mo65t ", "VNI"), , 1)
        Else
            Digi = UCase(Left(Digi, 1)) & Mid(Digi, 2)
        End If
    End If
    hpvnd = Digi & Deci & UniConvert(" d9o62ng.", "VNI") '& "."
End Function
'***************************************************************************************************

''This is a supplemental function for 'hpvnd' function:
Private Function Hundreds(ByVal StrNum As String) As String
    Dim Units, LessThanTwenty, Tens, LessThanTen
    Units = Array(UniConvert("kho6ng", "VNI"), UniConvert("mo65t", "VNI"), "hai", "ba", UniConvert("bo61n", "VNI"), UniConvert("na8m", "VNI"), UniConvert("sa1u", "VNI"), UniConvert("ba3y", "VNI"), UniConvert("ta1m", "VNI"), UniConvert("chi1n", "VNI"))
    LessThanTwenty = Array(UniConvert("mu7o72i", "VNI"), UniConvert("mu7o72i mo65t", "VNI"), UniConvert("mu7o72i hai", "VNI"), UniConvert("mu7o72i ba", "VNI"), UniConvert("mu7o72i bo61n", "VNI"), UniConvert("mu7o72i na8m", "VNI"), UniConvert("mu7o72i sa1u", "VNI"), _
                           UniConvert("mu7o72i ba3y", "VNI"), UniConvert("mu7o72i ta1m", "VNI"), UniConvert("mu7o72i chi1n", "VNI"))
    LessThanTen = Array(UniConvert("le3 mo65t", "VNI"), UniConvert("le3 hai", "VNI"), UniConvert("le3 ba", "VNI"), UniConvert("le3 bo61n", "VNI"), UniConvert("le3 na8m", "VNI"), UniConvert("le3 sa1u", "VNI"), _
                           UniConvert("le3 ba3y", "VNI"), UniConvert("le3 ta1m", "VNI"), UniConvert("le3 chi1n", "VNI"))
    Tens = Array(UniConvert("mu7o72i", "VNI"), UniConvert("hai mu7o7i", "VNI"), UniConvert("ba mu7o7i", "VNI"), UniConvert("bo61n mu7o7i", "VNI"), UniConvert("na8m mu7o7i", "VNI"), UniConvert("sa1u mu7o7i", "VNI"), UniConvert("ba3y mu7o7i", "VNI"), UniConvert("ta1m mu7o7i", "VNI"), UniConvert("chi1n mu7o7i", "VNI"))
    Dim Len1 As String, Len2 As String, Len3 As String
    Select Case Len(StrNum)
    Case 1
        Hundreds = Units(StrNum)
    Case 2
        Select Case StrNum
        Case Is < 20
            Hundreds = LessThanTwenty(StrNum - 10)
        Case Else
            If StrNum Mod 10 = 0 Then
                Hundreds = Tens(StrNum / 10 - 1)
            Else
                Len1 = Right(StrNum, 1)
                Len2 = (StrNum - Len1) / 10 - 1
                Hundreds = Tens(Len2) & " " & Units(Len1)
            End If
        End Select
    Case Else
        Len3 = Left(StrNum, 1)
        Hundreds = Units(Len3) & UniConvert(" tra8m", "VNI")
        Len3 = Val(Right(StrNum, 2))
       
        If Len3 > 0 Then
            Dim Hdrs As String
            Select Case Len(Len3)
            Case 1
                Hdrs = UniConvert("le3 ", "VNI") & Units(Len3)
            Case 2
                'Select Case Len3
                 If Len3 < 10 Then
                 Hdrs = LessThanTen(Len3)
                 Else
                 If Len3 > 9 Then
                                 
                'Case Else
                    If StrNum Mod 10 = 0 Then
                        Hdrs = Tens(Len3 / 10 - 1)
                    Else
                        Len1 = Right(Len3, 1)
                        Len2 = (Len3 - Len1) / 10 - 1
                        Hdrs = Tens(Len2) & " " & Units(Len1)
                    End If
                End If
                End If
                'End Select
            End Select
            Hundreds = Hundreds & " " & Hdrs
        End If
    End Select
End Function
'***************************************************************************************************

''This is a supplemental function for 'hpvnd' function:
Private Function DecimalSpelling(ByVal Series As String) As Variant
    Dim DeciSpell(0 To 1)
    Dim Point As Long, Deci As String, Digi As String
    Point = InStr(Series, "."):  Digi = Series
    If Point = 0 Then
GoTo ExitFunction
    Else
        Deci = Mid(Series, Point)
        If Deci = 0 Then
GoTo ExitFunction
        Else
            Digi = Replace(Series, Deci, "")
            If Len(Deci) > 4 Then
                Deci = Format(Deci, "0.000")
                If Deci = 0 Then
GoTo ExitFunction
                ElseIf Deci = 1 Then
                    DeciSpell(0) = Format(Digi + 1, "#,##0")
                    DeciSpell(1) = ""
                    DecimalSpelling = DeciSpell
                    Exit Function
                Else
                    Deci = Replace(Deci, "0.", "")
                End If
            Else
                Deci = Replace(Deci, ".", "")
            End If
            Dim Units, arrUnits, Tens, i As Long, j As Long
            Units = Array(UniConvert("kho6ng", "VNI"), UniConvert("mo65t", "VNI"), " hai", "ba", UniConvert("bo61n", "VNI"), UniConvert("na8m", "VNI"), UniConvert("sa1u", "VNI"), UniConvert("ba3y", "VNI"), UniConvert("ta1m", "VNI"), UniConvert("chi1n", "VNI"))
            j = Len(Deci)
            ReDim arrUnits(1 To j)
            For i = 1 To j
                arrUnits(i) = Units(Mid(Deci, i, 1))
            Next
            DeciSpell(0) = Format(Digi, "#,##0")
            DeciSpell(1) = UniConvert(" pha63y ", "VNI") & Join(arrUnits, " ")
        End If
    End If
    DecimalSpelling = DeciSpell
    Exit Function
ExitFunction:
    DeciSpell(0) = Format(Digi, "#,##0")
    DeciSpell(1) = ""
    DecimalSpelling = DeciSpell
End Function
'***************************************************************************************************
Chừ bạn lấy nguyên 2 hàm tại đề bài của bạn rồi thêm cái hàm này thử đọc số có đúng ý bạn không nhé:

Function DocVnd(Num As Currency) As String
Dim arr, PhanChan
Dim VT As Integer, VT1 As Integer, VT2 As Integer, i As Integer, j As Integer, dem As Integer, Nhom As Integer
Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer, Dong As Integer
Dim Chu As String, Chu2 As String

Chu = vnd(Num)
PhanChan = Trim$(str$(Int(Num)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan

NganTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Ngan = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
arr = Array(NganTy, Ty, Trieu, Ngan, Dong)
For i = 0 To 4
If Val(arr(i)) <> 0 Then
Nhom = Nhom + 1
End If
Next
VT = InStr(1, Chu, ",")
Chu2 = Mid(Chu, 1, VT - 1)
If Nhom = 5 Then
Chu2 = Left(Chu2, Len(Chu2) - 3)
End If
For i = (5 - Nhom + 1) To 4
For j = 1 To i
If j = i - 1 Then
VT1 = InStr(VT1 + 1, Chu, ",")
ElseIf j = i Then
If Nhom = 5 And i = 1 Then
VT1 = InStr(VT1 + 1, Chu, ",")
VT2 = InStr(VT1 + 1, Chu, ",")
Else
VT2 = InStr(VT1 + 1, Chu, ",")
End If
End If
Next
If VT2 = 0 Then VT2 = Len(Chu) + 1
If Len(Trim(arr(i))) = 3 Then
Chu2 = Chu2 + ", " + Trim(Mid(Chu, VT1 + 1, VT2 - VT1 - 1))
ElseIf Len(Trim(arr(i))) = 2 Then
Chu2 = Chu2 + "," + " không tr" & ChrW(259) & "m " + Trim(Mid(Chu, VT1 + 1, VT2 - VT1 - 1))
ElseIf Len(Trim(arr(i))) = 1 Then
Chu2 = Chu2 + "," + " không tr" & ChrW(259) + "m l" & ChrW(7867) & " " + Trim(Mid(Chu, VT1 + 1, VT2 - VT1 - 1))
End If
Next

DocVnd = Chu2
End Function
 
Chừ bạn lấy nguyên 2 hàm tại đề bài của bạn rồi thêm cái hàm này thử đọc số có đúng ý bạn không nhé:

Function DocVnd(Num As Currency) As String
Dim arr, PhanChan
Dim VT As Integer, VT1 As Integer, VT2 As Integer, i As Integer, j As Integer, dem As Integer, Nhom As Integer
Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer, Dong As Integer
Dim Chu As String, Chu2 As String

Chu = vnd(Num)
PhanChan = Trim$(str$(Int(Num)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan

NganTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Ngan = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
arr = Array(NganTy, Ty, Trieu, Ngan, Dong)
For i = 0 To 4
If Val(arr(i)) <> 0 Then
Nhom = Nhom + 1
End If
Next
VT = InStr(1, Chu, ",")
Chu2 = Mid(Chu, 1, VT - 1)
If Nhom = 5 Then
Chu2 = Left(Chu2, Len(Chu2) - 3)
End If
For i = (5 - Nhom + 1) To 4
For j = 1 To i
If j = i - 1 Then
VT1 = InStr(VT1 + 1, Chu, ",")
ElseIf j = i Then
If Nhom = 5 And i = 1 Then
VT1 = InStr(VT1 + 1, Chu, ",")
VT2 = InStr(VT1 + 1, Chu, ",")
Else
VT2 = InStr(VT1 + 1, Chu, ",")
End If
End If
Next
If VT2 = 0 Then VT2 = Len(Chu) + 1
If Len(Trim(arr(i))) = 3 Then
Chu2 = Chu2 + ", " + Trim(Mid(Chu, VT1 + 1, VT2 - VT1 - 1))
ElseIf Len(Trim(arr(i))) = 2 Then
Chu2 = Chu2 + "," + " không tr" & ChrW(259) & "m " + Trim(Mid(Chu, VT1 + 1, VT2 - VT1 - 1))
ElseIf Len(Trim(arr(i))) = 1 Then
Chu2 = Chu2 + "," + " không tr" & ChrW(259) + "m l" & ChrW(7867) & " " + Trim(Mid(Chu, VT1 + 1, VT2 - VT1 - 1))
End If
Next

DocVnd = Chu2
End Function
Mình đã thử và cũng đạt được mục đích mong muốn.
Cảm ơn bác đã dành thời gian hướng dẫn.
 
Web KT
Back
Top Bottom