Đọc số tiền ra chữ

Liên hệ QC

dangky47h

Thành viên thường trực
Tham gia
4/9/17
Bài viết
329
Được thích
41
Giới tính
Nam
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!
 
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
 
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
 
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ố
 
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
 
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à.
 
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:
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.
 
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

  • Doc so thanh chu.xls
    82 KB · Đọc: 6
Lần chỉnh sửa cuối:
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
 
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)
 
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!
 
Web KT
Back
Top Bottom