Đọc số tiền ra chữ

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
310
Được thích
33
Điểm
185
Tuổi
32
Do đặc thù công việc, em xin nhờ các Anh, chị trên diễn đàn:
Giúp em một hàm tự tạo bằng ngôn ngữ VBA để đọc số tiền từ số ra chữ
Giả sử ô A1: 30.000.001.500
Thì sẽ tạo một hàm =Docso(A1) sẽ cho ra kết quả là: Ba mươi tỷ không trăm linh một nghìn năm trăm đồng
Lưu ý: chỉ dùng "linh" không dùng "lẻ"
Chỉ dùng "nghìn" không dùng ngàn
Không dùng từ "chẵn" kết thúc cuối cùng khi đọc số tiền

Em xin cảm ơn!
 

saobekhonglac

Thành viên tích cực
Tham gia ngày
1 Tháng mười một 2008
Bài viết
1,268
Được thích
862
Điểm
860
Nơi ở
Long An - HCM
Do đặc thù công việc, em xin nhờ các Anh, chị trên diễn đàn:
Giúp em một hàm tự tạo bằng ngôn ngữ VBA để đọc số tiền từ số ra chữ
Giả sử ô A1: 30.000.001.500
Thì sẽ tạo một hàm =Docso(A1) sẽ cho ra kết quả là: Ba mươi tỷ không trăm linh một nghìn năm trăm đồng
Lưu ý: chỉ dùng "linh" không dùng "lẻ"
Chỉ dùng "nghìn" không dùng ngàn
Không dùng từ "chẵn" kết thúc cuối cùng khi đọc số tiền

Em xin cảm ơn!
Dùng thử code này
Mã:
Function DocSoUni(conso) As String
s09 = Array("", " m" & ChrW(7897) & "t", " hai", " ba", " b" & ChrW(7889) & "n", " n" & ChrW(259) & "m", " s" & ChrW(225) & "u", " b" & ChrW(7843) & "y", " t" & ChrW(225) & "m", " ch" & ChrW(237) & "n")
lop3 = Array("", " tri" & ChrW(7879) & "u", " ngh" & ChrW(236) & "n", " t" & ChrW(7927))
'Stop
If Trim(conso) = "" Then
DocSoUni = ""
ElseIf IsNumeric(conso) = True Then
If conso < 0 Then dau = ChrW(226) & "m " Else dau = ""
conso = Application.WorksheetFunction.Round(Abs(conso), 0)
conso = " " & conso
conso = Replace(conso, ",", "", 1)
vt = InStr(1, conso, "E")
If vt > 0 Then
sonhan = Val(Mid(conso, vt + 1))
conso = Trim(Mid(conso, 2, vt - 2))
conso = conso & String(sonhan - Len(conso) + 1, "0")
End If
conso = Trim(conso)
sochuso = Len(conso) Mod 9
If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
docso = ""
i = 1
lop = 1
Do
n1 = Mid(conso, i, 1)
n2 = Mid(conso, i + 1, 1)
n3 = Mid(conso, i + 2, 1)
baso = Mid(conso, i, 3)
i = i + 3
If n1 & n2 & n3 = "000" Then
If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " t" & ChrW(7927) Else s123 = ""
Else
If n1 = 0 Then
If docso = "" Then s1 = "" Else s1 = " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
Else
s1 = s09(n1) & " tr" & ChrW(259) & "m"
End If
If n2 = 0 Then
If s1 = "" Or n3 = 0 Then
s2 = ""
Else
s2 = " linh"
End If
Else
If n2 = 1 Then s2 = " m" & ChrW(432) & ChrW(7901) & "i" Else s2 = s09(n2) & " m" & ChrW(432) & ChrW(417) & "i"
End If
If n3 = 1 Then
If n2 = 1 Or n2 = 0 Then s3 = " m" & ChrW(7897) & "t" Else s3 = " m" & ChrW(7889) & "t"
ElseIf n3 = 5 And n2 <> 0 Then
s3 = " l" & ChrW(259) & "m"
Else
s3 = s09(n3)
End If
If i > Len(conso) Then
s123 = s1 & s2 & s3
Else
s123 = s1 & s2 & s3 & lop3(lop)
End If
End If
lop = lop + 1
If lop > 3 Then lop = 1
docso = docso & s123
If i > Len(conso) Then Exit Do
Loop
If docso = "" Then DocSoUni = "kh" & ChrW(244) & "ng" Else DocSoUni = dau & Trim(docso)
Else
DocSoUni = conso
End If
End Function
 

phulien1902

GPE - My love
Tham gia ngày
6 Tháng bảy 2013
Bài viết
3,377
Được thích
4,158
Điểm
560
Nơi ở
Hải Phòng
Dùng thử code này
Mã:
Function DocSoUni(conso) As String
s09 = Array("", " m" & ChrW(7897) & "t", " hai", " ba", " b" & ChrW(7889) & "n", " n" & ChrW(259) & "m", " s" & ChrW(225) & "u", " b" & ChrW(7843) & "y", " t" & ChrW(225) & "m", " ch" & ChrW(237) & "n")
lop3 = Array("", " tri" & ChrW(7879) & "u", " ngh" & ChrW(236) & "n", " t" & ChrW(7927))
'Stop
If Trim(conso) = "" Then
DocSoUni = ""
ElseIf IsNumeric(conso) = True Then
If conso < 0 Then dau = ChrW(226) & "m " Else dau = ""
conso = Application.WorksheetFunction.Round(Abs(conso), 0)
conso = " " & conso
conso = Replace(conso, ",", "", 1)
vt = InStr(1, conso, "E")
If vt > 0 Then
sonhan = Val(Mid(conso, vt + 1))
conso = Trim(Mid(conso, 2, vt - 2))
conso = conso & String(sonhan - Len(conso) + 1, "0")
End If
conso = Trim(conso)
sochuso = Len(conso) Mod 9
If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
docso = ""
i = 1
lop = 1
Do
n1 = Mid(conso, i, 1)
n2 = Mid(conso, i + 1, 1)
n3 = Mid(conso, i + 2, 1)
baso = Mid(conso, i, 3)
i = i + 3
If n1 & n2 & n3 = "000" Then
If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " t" & ChrW(7927) Else s123 = ""
Else
If n1 = 0 Then
If docso = "" Then s1 = "" Else s1 = " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
Else
s1 = s09(n1) & " tr" & ChrW(259) & "m"
End If
If n2 = 0 Then
If s1 = "" Or n3 = 0 Then
s2 = ""
Else
s2 = " linh"
End If
Else
If n2 = 1 Then s2 = " m" & ChrW(432) & ChrW(7901) & "i" Else s2 = s09(n2) & " m" & ChrW(432) & ChrW(417) & "i"
End If
If n3 = 1 Then
If n2 = 1 Or n2 = 0 Then s3 = " m" & ChrW(7897) & "t" Else s3 = " m" & ChrW(7889) & "t"
ElseIf n3 = 5 And n2 <> 0 Then
s3 = " l" & ChrW(259) & "m"
Else
s3 = s09(n3)
End If
If i > Len(conso) Then
s123 = s1 & s2 & s3
Else
s123 = s1 & s2 & s3 & lop3(lop)
End If
End If
lop = lop + 1
If lop > 3 Then lop = 1
docso = docso & s123
If i > Len(conso) Then Exit Do
Loop
If docso = "" Then DocSoUni = "kh" & ChrW(244) & "ng" Else DocSoUni = dau & Trim(docso)
Else
DocSoUni = conso
End If
End Function
Vẫn thiếu chữ "đồng"

06-11-2019 9-49-24 AM.jpg
 

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
310
Được thích
33
Điểm
185
Tuổi
32

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
310
Được thích
33
Điểm
185
Tuổi
32
Dùng thử code này
Mã:
Function DocSoUni(conso) As String
s09 = Array("", " m" & ChrW(7897) & "t", " hai", " ba", " b" & ChrW(7889) & "n", " n" & ChrW(259) & "m", " s" & ChrW(225) & "u", " b" & ChrW(7843) & "y", " t" & ChrW(225) & "m", " ch" & ChrW(237) & "n")
lop3 = Array("", " tri" & ChrW(7879) & "u", " ngh" & ChrW(236) & "n", " t" & ChrW(7927))
'Stop
If Trim(conso) = "" Then
DocSoUni = ""
ElseIf IsNumeric(conso) = True Then
If conso < 0 Then dau = ChrW(226) & "m " Else dau = ""
conso = Application.WorksheetFunction.Round(Abs(conso), 0)
conso = " " & conso
conso = Replace(conso, ",", "", 1)
vt = InStr(1, conso, "E")
If vt > 0 Then
sonhan = Val(Mid(conso, vt + 1))
conso = Trim(Mid(conso, 2, vt - 2))
conso = conso & String(sonhan - Len(conso) + 1, "0")
End If
conso = Trim(conso)
sochuso = Len(conso) Mod 9
If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
docso = ""
i = 1
lop = 1
Do
n1 = Mid(conso, i, 1)
n2 = Mid(conso, i + 1, 1)
n3 = Mid(conso, i + 2, 1)
baso = Mid(conso, i, 3)
i = i + 3
If n1 & n2 & n3 = "000" Then
If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " t" & ChrW(7927) Else s123 = ""
Else
If n1 = 0 Then
If docso = "" Then s1 = "" Else s1 = " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
Else
s1 = s09(n1) & " tr" & ChrW(259) & "m"
End If
If n2 = 0 Then
If s1 = "" Or n3 = 0 Then
s2 = ""
Else
s2 = " linh"
End If
Else
If n2 = 1 Then s2 = " m" & ChrW(432) & ChrW(7901) & "i" Else s2 = s09(n2) & " m" & ChrW(432) & ChrW(417) & "i"
End If
If n3 = 1 Then
If n2 = 1 Or n2 = 0 Then s3 = " m" & ChrW(7897) & "t" Else s3 = " m" & ChrW(7889) & "t"
ElseIf n3 = 5 And n2 <> 0 Then
s3 = " l" & ChrW(259) & "m"
Else
s3 = s09(n3)
End If
If i > Len(conso) Then
s123 = s1 & s2 & s3
Else
s123 = s1 & s2 & s3 & lop3(lop)
End If
End If
lop = lop + 1
If lop > 3 Then lop = 1
docso = docso & s123
If i > Len(conso) Then Exit Do
Loop
If docso = "" Then DocSoUni = "kh" & ChrW(244) & "ng" Else DocSoUni = dau & Trim(docso)
Else
DocSoUni = conso
End If
End Function
Nhờ anh,chị sửa giúp thêm chữ ''đồng" khi đọc số
 

saobekhonglac

Thành viên tích cực
Tham gia ngày
1 Tháng mười một 2008
Bài viết
1,268
Được thích
862
Điểm
860
Nơi ở
Long An - HCM
Còn chữ đầu câu phải viết hoa chứ nhỉ? ( trong bài sửa "ba" thành "Ba")
Thêm code này sau đó sửa lại hàm thành =Viethoa_Kytudau(DocSoUni(A1))&" đồng"
Mã:
Function Viethoa_Kytudau(ByVal strContent As String) As String
    Dim m As Object
    strContent = LCase(strContent)
    strContent = Application.Replace(strContent, 1, 1, UCase(Left$(strContent, 1)))
    With CreateObject("VBScript.RegExp")
        .Pattern = "\.\s."
        .Global = True
        For Each m In .Execute(strContent)
            strContent = Application.Replace(strContent, m.FirstIndex + 1, m.Length, UCase(m.Value))
        Next
    End With
    Viethoa_Kytudau = strContent
End Function
 

leonguyenz

Thành viên mới
Thành viên BQT
Moderator
Tham gia ngày
2 Tháng tám 2010
Bài viết
4,439
Được thích
7,808
Điểm
610
Nơi ở
Bình Dương
Thêm code này sau đó sửa lại hàm thành =Viethoa_Kytudau(DocSoUni(A1))&" đồng"
Mã:
Function Viethoa_Kytudau(ByVal strContent As String) As String
    Dim m As Object
    strContent = LCase(strContent)
    strContent = Application.Replace(strContent, 1, 1, UCase(Left$(strContent, 1)))
    With CreateObject("VBScript.RegExp")
        .Pattern = "\.\s."
        .Global = True
        For Each m In .Execute(strContent)
            strContent = Application.Replace(strContent, m.FirstIndex + 1, m.Length, UCase(m.Value))
        Next
    End With
    Viethoa_Kytudau = strContent
End Function
Xài dao mổ trâu rồi bạn ơi :D
Dùng Left, Mid, Right cũng ngon lành mà.
 

be09

TNMT_Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
8,381
Được thích
8,146
Điểm
560
Tuổi
62
Nơi ở
Biên Hòa, Đồng Nai
Do đặc thù công việc, em xin nhờ các Anh, chị trên diễn đàn:
Giúp em một hàm tự tạo bằng ngôn ngữ VBA để đọc số tiền từ số ra chữ
Giả sử ô A1: 30.000.001.500
Thì sẽ tạo một hàm =Docso(A1) sẽ cho ra kết quả là: Ba mươi tỷ không trăm linh một nghìn năm trăm đồng
Lưu ý: chỉ dùng "linh" không dùng "lẻ"
Chỉ dùng "nghìn" không dùng ngàn
Không dùng từ "chẵn" kết thúc cuối cùng khi đọc số tiền

Em xin cảm ơn!
Tham khảo code trong File, số 1.407.123 nó đọc số bằng chữ thế này (tôi sửa code lẻ thành linh).

(Một triệu, bốn trăm linh bảy ngàn, một trăm hai mươi ba đồng)

Bạn tải lại File bài 14.
 
Lần chỉnh sửa cuối:

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
310
Được thích
33
Điểm
185
Tuổi
32
Tham khảo code trong File, số 1.407.123 nó đọc số bằng chữ thế này.

(Một triệu, bốn trăm lẻ bảy ngàn, một trăm hai mươi ba đồng)
Mã:
Option Explicit
Public Function VNdong(FirstArg As Object)
Dim chu, aaa, bbb, so3
chu = Abs(FirstArg.Value)
chu = Format(chu, "0.00")
If chu > 10 ^ 99 Then
    VNdong = FirstArg.Value
    Exit Function
End If
aaa = Left(chu, Len(chu) - 3)
bbb = Right(chu, 2)

'so3 = dich(CStr(aaa)) & "ñoàng" & IIf(Val(bbb) <> 0, " " & dich(CStr(bbb)) & "xu.", ".") 'góc
so3 = dich(CStr(aaa)) & "ñoàng" & IIf(Val(bbb) <> 0, " " & dich(CStr(bbb)) & "xu.", ")")

so3 = Replace(so3, ", tyû", " tyû")              '* Lam cho dep
so3 = Replace(so3, ", ñoàng", " ñoàng")
so3 = "(" & Chr(Asc(Left(so3, 1)) - 32) + Mid(so3, 2) ' Viet hoa chu dau tien
If FirstArg.Value < 0 Then so3 = "(AÂm) " & so3
VNdong = vni2u(CStr(so3))
End Function

Function dich(yy As String)
Dim mm, docso, kkdai
kkdai = Len(yy)
If Len(yy) < 10 Then
    docso = ""
    For mm = 1 To Len(yy)
        docso = docso & Mid(yy, mm, 1) & Chr(65 + Len(yy) - mm)
    Next
Else
    'docso = dich(Left(yy, kkdai - 9)) & "tyû, " & dich(Right(yy, 9))
     docso = dich(Left(yy, kkdai - 9)) & "t" & ChrW(7927) & ", " & dich(Right(yy, 9))
    dich = docso
    Exit Function
End If

docso = Replace(docso, "A", "donvi")
docso = Replace(docso, "B", "möôi ")
docso = Replace(docso, "C", "traêm ")
docso = Replace(docso, "D", "ngaøn, ")
docso = Replace(docso, "E", "möôi ")
docso = Replace(docso, "F", "traêm ")
docso = Replace(docso, "G", "trieäu, ")
docso = Replace(docso, "H", "möôi ")
docso = Replace(docso, "I", "traêm ")
docso = Replace(docso, "0", "khoâng ")
docso = Replace(docso, "1", "moät ")
docso = Replace(docso, "2", "hai ")
docso = Replace(docso, "3", "ba ")
docso = Replace(docso, "4", "boán ")
docso = Replace(docso, "5", "naêm ")
docso = Replace(docso, "6", "saùu ")
docso = Replace(docso, "7", "baûy ")
docso = Replace(docso, "8", "taùm ")
docso = Replace(docso, "9", "chín ")
docso = Replace(docso, "khoâng möôi", "leû")      '* Buoc hoan chinh
docso = Replace(docso, "möôi khoâng", "möôi")
docso = Replace(docso, "khoâng traêm leû khoâng ", "khoâng ")
docso = Replace(docso, "traêm leû khoâng", "traêm")
docso = Replace(docso, "möôi naêm", "möôi laêm")
docso = Replace(docso, "moät möôi", "möôøi")
docso = Replace(docso, "möôi moät", "möôi moát")
docso = Replace(docso, " khoâng donvi", " donvi")
docso = Replace(docso, "khoâng ngaøn, donvi", "donvi")
docso = Replace(docso, "khoâng trieäu, donvi", "donvi")
docso = Replace(docso, "donvi", "")
dich = docso

End Function


Function vni2u(vanbanVNI As String)
vni2u = vanbanVNI                    '* Luu y khong duoc thay doi thu tu cac dong duoi day
vni2u = Replace(vni2u, "aù", ChrW(225))
vni2u = Replace(vni2u, "aø", ChrW(224))
vni2u = Replace(vni2u, "aû", ChrW(7843))
vni2u = Replace(vni2u, "aõ", ChrW(227))
vni2u = Replace(vni2u, "aï", ChrW(7841))
vni2u = Replace(vni2u, "aé", ChrW(7855))
vni2u = Replace(vni2u, "aè", ChrW(7857))
vni2u = Replace(vni2u, "aú", ChrW(7859))
vni2u = Replace(vni2u, "aü", ChrW(7861))
vni2u = Replace(vni2u, "aë", ChrW(7863))
vni2u = Replace(vni2u, "aá", ChrW(7845))
vni2u = Replace(vni2u, "aà", ChrW(7847))
vni2u = Replace(vni2u, "aå", ChrW(7849))
vni2u = Replace(vni2u, "aã", ChrW(7851))
vni2u = Replace(vni2u, "aä", ChrW(7853))
vni2u = Replace(vni2u, "où", ChrW(243))
vni2u = Replace(vni2u, "oø", ChrW(242))
vni2u = Replace(vni2u, "oû", ChrW(7887))
vni2u = Replace(vni2u, "oõ", ChrW(245))
vni2u = Replace(vni2u, "oï", ChrW(7885))
vni2u = Replace(vni2u, "oá", ChrW(7889))
vni2u = Replace(vni2u, "oà", ChrW(7891))
vni2u = Replace(vni2u, "oå", ChrW(7893))
vni2u = Replace(vni2u, "oã", ChrW(7895))
vni2u = Replace(vni2u, "oä", ChrW(7897))
vni2u = Replace(vni2u, "ôù", ChrW(7899))
vni2u = Replace(vni2u, "ôø", ChrW(7901))
vni2u = Replace(vni2u, "ôû", ChrW(7903))
vni2u = Replace(vni2u, "ôõ", ChrW(7905))
vni2u = Replace(vni2u, "ôï", ChrW(7907))
vni2u = Replace(vni2u, "uù", ChrW(250))
vni2u = Replace(vni2u, "uø", ChrW(249))
vni2u = Replace(vni2u, "uû", ChrW(7911))
vni2u = Replace(vni2u, "uõ", ChrW(361))
vni2u = Replace(vni2u, "uï", ChrW(7909))
vni2u = Replace(vni2u, "öù", ChrW(7913))
vni2u = Replace(vni2u, "öø", ChrW(7915))
vni2u = Replace(vni2u, "öû", ChrW(7917))
vni2u = Replace(vni2u, "öõ", ChrW(7919))
vni2u = Replace(vni2u, "öï", ChrW(7921))
vni2u = Replace(vni2u, "eù", ChrW(233))
vni2u = Replace(vni2u, "eø", ChrW(232))
vni2u = Replace(vni2u, "eû", ChrW(7867))
vni2u = Replace(vni2u, "eõ", ChrW(7869))
vni2u = Replace(vni2u, "eï", ChrW(7865))
vni2u = Replace(vni2u, "eá", ChrW(7871))
vni2u = Replace(vni2u, "eà", ChrW(7873))
vni2u = Replace(vni2u, "eå", ChrW(7875))
vni2u = Replace(vni2u, "eã", ChrW(7877))
vni2u = Replace(vni2u, "eä", ChrW(7879))
vni2u = Replace(vni2u, "yù", ChrW(253))
vni2u = Replace(vni2u, "yø", ChrW(7923))
vni2u = Replace(vni2u, "yœ", ChrW(7927))
vni2u = Replace(vni2u, "yõ", ChrW(7929))
vni2u = Replace(vni2u, "î", ChrW(7925))
vni2u = Replace(vni2u, "AÙ", ChrW(193))
vni2u = Replace(vni2u, "AØ", ChrW(192))
vni2u = Replace(vni2u, "AÛ", ChrW(7842))
vni2u = Replace(vni2u, "AÕ", ChrW(195))
vni2u = Replace(vni2u, "AÏ", ChrW(7840))
vni2u = Replace(vni2u, "AÉ", ChrW(7854))
vni2u = Replace(vni2u, "AÈ", ChrW(7856))
vni2u = Replace(vni2u, "AÚ", ChrW(7858))
vni2u = Replace(vni2u, "AÜ", ChrW(7860))
vni2u = Replace(vni2u, "AË", ChrW(7862))
vni2u = Replace(vni2u, "AÁ", ChrW(7844))
vni2u = Replace(vni2u, "AÀ", ChrW(7846))
vni2u = Replace(vni2u, "AÅ", ChrW(7848))
vni2u = Replace(vni2u, "AÃ", ChrW(7850))
vni2u = Replace(vni2u, "AÄ", ChrW(7852))
vni2u = Replace(vni2u, "EÙ", ChrW(201))
vni2u = Replace(vni2u, "EØ", ChrW(200))
vni2u = Replace(vni2u, "EÛ", ChrW(7866))
vni2u = Replace(vni2u, "EÕ", ChrW(7868))
vni2u = Replace(vni2u, "EÏ", ChrW(7864))
vni2u = Replace(vni2u, "EÁ", ChrW(7870))
vni2u = Replace(vni2u, "EÀ", ChrW(7872))
vni2u = Replace(vni2u, "EÅ", ChrW(7874))
vni2u = Replace(vni2u, "EÃ", ChrW(7876))
vni2u = Replace(vni2u, "EÄ", ChrW(7878))
vni2u = Replace(vni2u, "OÙ", ChrW(211))
vni2u = Replace(vni2u, "OØ", ChrW(210))
vni2u = Replace(vni2u, "OÛ", ChrW(7886))
vni2u = Replace(vni2u, "OÕ", ChrW(213))
vni2u = Replace(vni2u, "OÏ", ChrW(7884))
vni2u = Replace(vni2u, "OÁ", ChrW(7888))
vni2u = Replace(vni2u, "OÀ", ChrW(7890))
vni2u = Replace(vni2u, "OÅ", ChrW(7892))
vni2u = Replace(vni2u, "OÃ", ChrW(7894))
vni2u = Replace(vni2u, "OÄ", ChrW(7896))
vni2u = Replace(vni2u, "ÔÙ", ChrW(7898))
vni2u = Replace(vni2u, "ÔØ", ChrW(7900))
vni2u = Replace(vni2u, "ÔÛ", ChrW(7902))
vni2u = Replace(vni2u, "ÔÕ", ChrW(7904))
vni2u = Replace(vni2u, "ÔÏ", ChrW(7906))
vni2u = Replace(vni2u, "UÙ", ChrW(218))
vni2u = Replace(vni2u, "UØ", ChrW(217))
vni2u = Replace(vni2u, "UÛ", ChrW(7910))
vni2u = Replace(vni2u, "UÕ", ChrW(360))
vni2u = Replace(vni2u, "UÏ", ChrW(7908))
vni2u = Replace(vni2u, "ÖÙ", ChrW(7912))
vni2u = Replace(vni2u, "ÖØ", ChrW(7914))
vni2u = Replace(vni2u, "ÖÛ", ChrW(7916))
vni2u = Replace(vni2u, "ÖÕ", ChrW(7918))
vni2u = Replace(vni2u, "ÖÏ", ChrW(7920))
vni2u = Replace(vni2u, "YÙ", ChrW(221))
vni2u = Replace(vni2u, "YØ", ChrW(7922))
vni2u = Replace(vni2u, "YÛ", ChrW(7926))
vni2u = Replace(vni2u, "YÕ", ChrW(7928))
vni2u = Replace(vni2u, "Î", ChrW(7924))
vni2u = Replace(vni2u, "ñ", ChrW(273))
vni2u = Replace(vni2u, "Ñ", ChrW(208))
vni2u = Replace(vni2u, "aê", ChrW(259))
vni2u = Replace(vni2u, "AÊ", ChrW(258))
vni2u = Replace(vni2u, "aâ", ChrW(226))
vni2u = Replace(vni2u, "AÂ", ChrW(194))
vni2u = Replace(vni2u, "eâ", ChrW(234))
vni2u = Replace(vni2u, "EÂ", ChrW(202))
vni2u = Replace(vni2u, "ô", ChrW(417))
vni2u = Replace(vni2u, "Ô", ChrW(416))
vni2u = Replace(vni2u, "oâ", ChrW(244))
vni2u = Replace(vni2u, "OÂ", ChrW(212))
vni2u = Replace(vni2u, "ö", ChrW(432))
vni2u = Replace(vni2u, "Ö", ChrW(431))
vni2u = Replace(vni2u, "Í", ChrW(205))
vni2u = Replace(vni2u, "Ì", ChrW(204))
vni2u = Replace(vni2u, "Æ", ChrW(7880))
vni2u = Replace(vni2u, "Ó", ChrW(296))
vni2u = Replace(vni2u, "Ò", ChrW(7882))
vni2u = Replace(vni2u, "í", ChrW(237))
vni2u = Replace(vni2u, "ì", ChrW(236))
vni2u = Replace(vni2u, "æ", ChrW(7881))
vni2u = Replace(vni2u, "ó", ChrW(297))
vni2u = Replace(vni2u, "ò", ChrW(7883))

End Function
Bác giúp em sửa từ "lẻ" thành"linh" được không bác
Cám ơn bác.
 

be09

TNMT_Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
8,381
Được thích
8,146
Điểm
560
Tuổi
62
Nơi ở
Biên Hòa, Đồng Nai
Mã:
Option Explicit
Public Function VNdong(FirstArg As Object)
......................................
End Function
Bác giúp em sửa từ "lẻ" thành"linh" được không bác
Cám ơn bác.
Tôi đang đã sửa lại lẻ thành Linh bạn thử lại, nếu có vấn đề gì thì nêu cụ thể tôi sẽ sửa lại giúp.
 

File đính kèm

Lần chỉnh sửa cuối:

giaiphap

Thành viên gạo cội
Tham gia ngày
12 Tháng ba 2007
Bài viết
4,815
Được thích
4,063
Điểm
860
Nhờ bác sửa giúp em code bài 2 của anh Saobekhonglac để có thêm chữ "đồng" nữa được không anh?
Tôi chỉ thêm chữ đồng vào trong code của #2 cho bạn thôi nhé, không hề sửa bất kỳ code nào của #2.
Mã:
Function DocSoUni(conso) As String
s09 = Array("", " m" & ChrW(7897) & "t", " hai", " ba", " b" & ChrW(7889) & "n", " n" & ChrW(259) & "m", " s" & ChrW(225) & "u", " b" & ChrW(7843) & "y", " t" & ChrW(225) & "m", " ch" & ChrW(237) & "n")
lop3 = Array("", " tri" & ChrW(7879) & "u", " ngh" & ChrW(236) & "n", " t" & ChrW(7927))
'Stop
If Trim(conso) = "" Then
DocSoUni = ""
ElseIf IsNumeric(conso) = True Then
If conso < 0 Then dau = ChrW(226) & "m " Else dau = ""
conso = Application.WorksheetFunction.Round(Abs(conso), 0)
conso = " " & conso
conso = Replace(conso, ",", "", 1)
vt = InStr(1, conso, "E")
If vt > 0 Then
sonhan = Val(Mid(conso, vt + 1))
conso = Trim(Mid(conso, 2, vt - 2))
conso = conso & String(sonhan - Len(conso) + 1, "0")
End If
conso = Trim(conso)
sochuso = Len(conso) Mod 9
If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
docso = ""
i = 1
lop = 1
Do
n1 = Mid(conso, i, 1)
n2 = Mid(conso, i + 1, 1)
n3 = Mid(conso, i + 2, 1)
baso = Mid(conso, i, 3)
i = i + 3
If n1 & n2 & n3 = "000" Then
If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " t" & ChrW(7927) Else s123 = ""
Else
If n1 = 0 Then
If docso = "" Then s1 = "" Else s1 = " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
Else
s1 = s09(n1) & " tr" & ChrW(259) & "m"
End If
If n2 = 0 Then
If s1 = "" Or n3 = 0 Then
s2 = ""
Else
s2 = " linh"
End If
Else
If n2 = 1 Then s2 = " m" & ChrW(432) & ChrW(7901) & "i" Else s2 = s09(n2) & " m" & ChrW(432) & ChrW(417) & "i"
End If
If n3 = 1 Then
If n2 = 1 Or n2 = 0 Then s3 = " m" & ChrW(7897) & "t" Else s3 = " m" & ChrW(7889) & "t"
ElseIf n3 = 5 And n2 <> 0 Then
s3 = " l" & ChrW(259) & "m"
Else
s3 = s09(n3)
End If
If i > Len(conso) Then
s123 = s1 & s2 & s3
Else
s123 = s1 & s2 & s3 & lop3(lop)
End If
End If
lop = lop + 1
If lop > 3 Then lop = 1
docso = docso & s123
If i > Len(conso) Then Exit Do
Loop
If docso = "" Then DocSoUni = "kh" & ChrW(244) & "ng" Else DocSoUni = dau & Trim(docso)
Else
DocSoUni = conso
End If
DocSoUni = DocSoUni & " " & ChrW(273) & ChrW(7891) & "ng"
End Function
 

le_vis

Thành viên tích cực
Tham gia ngày
23 Tháng bảy 2009
Bài viết
819
Được thích
405
Điểm
735
Tuổi
36
Tôi đang đã sửa lại lẻ thành Linh bạn thử lại, nếu có vấn đề gì thì nêu cụ thể tôi sẽ sửa lại giúp.
Anh xem lại trường hợp : 1.500.006.800.750
nó đọc là
(Một ngàn, năm trăm linh tỷ, không trăm linh sáu triệu, tám trăm linh không ngàn, bảy trăm năm mươi đồng)
 

quanglenb

Thành viên chính thức
Tham gia ngày
2 Tháng mười một 2019
Bài viết
52
Được thích
8
Điểm
20
Tuổi
29
Tôi chỉ thêm chữ đồng vào trong code của #2 cho bạn thôi nhé, không hề sửa bất kỳ code nào của #2.
Mã:
Function DocSoUni(conso) As String
s09 = Array("", " m" & ChrW(7897) & "t", " hai", " ba", " b" & ChrW(7889) & "n", " n" & ChrW(259) & "m", " s" & ChrW(225) & "u", " b" & ChrW(7843) & "y", " t" & ChrW(225) & "m", " ch" & ChrW(237) & "n")
lop3 = Array("", " tri" & ChrW(7879) & "u", " ngh" & ChrW(236) & "n", " t" & ChrW(7927))
'Stop
If Trim(conso) = "" Then
DocSoUni = ""
ElseIf IsNumeric(conso) = True Then
If conso < 0 Then dau = ChrW(226) & "m " Else dau = ""
conso = Application.WorksheetFunction.Round(Abs(conso), 0)
conso = " " & conso
conso = Replace(conso, ",", "", 1)
vt = InStr(1, conso, "E")
If vt > 0 Then
sonhan = Val(Mid(conso, vt + 1))
conso = Trim(Mid(conso, 2, vt - 2))
conso = conso & String(sonhan - Len(conso) + 1, "0")
End If
conso = Trim(conso)
sochuso = Len(conso) Mod 9
If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
docso = ""
i = 1
lop = 1
Do
n1 = Mid(conso, i, 1)
n2 = Mid(conso, i + 1, 1)
n3 = Mid(conso, i + 2, 1)
baso = Mid(conso, i, 3)
i = i + 3
If n1 & n2 & n3 = "000" Then
If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " t" & ChrW(7927) Else s123 = ""
Else
If n1 = 0 Then
If docso = "" Then s1 = "" Else s1 = " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
Else
s1 = s09(n1) & " tr" & ChrW(259) & "m"
End If
If n2 = 0 Then
If s1 = "" Or n3 = 0 Then
s2 = ""
Else
s2 = " linh"
End If
Else
If n2 = 1 Then s2 = " m" & ChrW(432) & ChrW(7901) & "i" Else s2 = s09(n2) & " m" & ChrW(432) & ChrW(417) & "i"
End If
If n3 = 1 Then
If n2 = 1 Or n2 = 0 Then s3 = " m" & ChrW(7897) & "t" Else s3 = " m" & ChrW(7889) & "t"
ElseIf n3 = 5 And n2 <> 0 Then
s3 = " l" & ChrW(259) & "m"
Else
s3 = s09(n3)
End If
If i > Len(conso) Then
s123 = s1 & s2 & s3
Else
s123 = s1 & s2 & s3 & lop3(lop)
End If
End If
lop = lop + 1
If lop > 3 Then lop = 1
docso = docso & s123
If i > Len(conso) Then Exit Do
Loop
If docso = "" Then DocSoUni = "kh" & ChrW(244) & "ng" Else DocSoUni = dau & Trim(docso)
Else
DocSoUni = conso
End If
DocSoUni = DocSoUni & " " & ChrW(273) & ChrW(7891) & "ng"
End Function
Cám ơn anh!
 
Top Bottom