Phần mềm ôn thi sát hạch chứng chỉ hành nghề xây dựng
Tiêu đề: [Nhờ chỉnh sửa] VBA diễn giải giá trị Đồng Việt Nam [In trang]
Tác giả: butua@vn Thời gian: 25/8/2016 12:24
Tiêu đề: [Nhờ chỉnh sửa] VBA diễn giải giá trị Đồng Việt Nam
Chào anh chị em xaydung360.vn !
Em đang sử dụng hàm VND (của đoạn code bên dưới) để diễn giải từ con số ra số tiền Bằng chữ. Tuy nhiên khi sử dụng, giá trị bằng chữ khi diễn giải không có dấu phẩy để ngăn cách giữa các giá trị đơn vị. Nhờ mọi người sửa giúp ạ.
Ví dụ cho dễ hiểu:
Giá trị tiền là: 1.234.567,0
Theo cách viết thông thường của em sẽ là: Một triệu, hai trăm ba mươi tư nghìn, năm trăm sáu mươi bảy đồng.
Theo diễn giải của hàm VND: Một triệu hai trăm ba mươi tư nghìn năm trăm sáu mươi bảy đồng (không có dấu phẩy. Cách viết này đối với em nó không được hay cho lắm, em muốn chỉnh sửa lại như cách trên ạ)[Visual Basic] 纯文本查看 复制代码
Function vnd(conso) As String
Dim nSheet As String
nSheet = ActiveSheet.Name
If nSheet <> "VLHT XD" And nSheet <> "VLHT TB" Then
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
vnd = ""
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"
ElseIf n3 = 4 And n2 <> 1 And n2 <> 4 And n1 = 4 Then S3 = " t" & ChrW(432)
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
vnd = UCase(Left(dau & Trim(docso), 1)) & Mid(dau & Trim(docso), 2) & " " & ChrW(273) & ChrW(7891) & "ng."
If Left(vnd, 2) = "T" & ChrW(432) Then
vnd = "B" & ChrW(7889) & "n" & Right(vnd, (Len(vnd) - 2))
End If
Else
'vnd = conso
End If
End If
End Function
Nhân tiện đây, em cũng xin chia sẻ về cách viết và cách đọc cho đúng về Đồng tiền Việt Nam:
http://dantri.com.vn/ban-doc/nen-goi-lai-cho-dung-la-dong-viet-nam-1308160101.htm
và Quy ước mã hiệu đồng tiền theo tiêu chuẩn Quốc tế ISO 4217
https://vi.wikipedia.org/wiki/ISO_4217
Thanks !
Tác giả: fubi Thời gian: 25/8/2016 13:21
Câu lệnh trên sửa lại dòng số 61 như sau:
s123 = s1 & s2 & S3 & lop3(LOP) & ", "
Là sẽ ra đúng ý của bạn.
Tác giả: tranhoe Thời gian: 25/8/2016 13:39
Dùng thử xem:
[Visual Basic] 纯文本查看 复制代码
Function vnd(conso) As String
Dim nSheet As String
nSheet = ActiveSheet.Name
If nSheet <> "VLHT XD" And nSheet <> "VLHT TB" Then
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
vnd = ""
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"
ElseIf n3 = 4 And n2 <> 1 And n2 <> 4 And n1 = 4 Then S3 = " t" & ChrW(432)
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
vnd = UCase(Left(dau & Trim(docso), 1)) & Mid(dau & Trim(docso), 2) & " " & ChrW(273) & ChrW(7891) & "ng."
If Left(vnd, 2) = "T" & ChrW(432) Then
vnd = "B" & ChrW(7889) & "n" & Right(vnd, (Len(vnd) - 2))
End If
Else
'vnd = conso
End If
End If
End Function
Tác giả: demdamsay Thời gian: 25/8/2016 15:47
Chú tranhoe xem lại. Hình như nó không đúng lắm với các giá trị. Ví dụ như: 1.000 ( Một nghìn, đồng),hoặc 1.000.000 (Một triệu, đồng), hoặc 1.000.000.000 (Một tỷ, đồng). Nói chung là các giá trị có 3 con số 0 ở cuối cùng.
Tác giả: butua@vn Thời gian: 25/8/2016 16:10
Chào chú Hoè !
Code sửa lại có một vấn đề với diễn giải khi là số chẵn 1.000 như anh @demdamsay đã ý kiến, Chú xem và sủa hoàn thiện giúp nhé !Cụ thể khi giá trị có ba hàng đơn vị là "000" thì nó thêm dấu phẩy trước chữ đồng. Ví dụ "Một nghìn, đồng"; "Mười nghìn, đồng" ....
Thanks !
Tác giả: fubi Thời gian: 25/8/2016 16:23
Sửa 1 câu lệnh và thêm 1 câu lệnh là OK như ý bạn:
- Sửa câu lệnh dòng lệnh số 61:
s123 = s1 & s2 & S3 & lop3(LOP) & ", "
(Mục đích câu lệnh này là thêm dấu phẩy sau khi đọc nhóm số phân cách hàng tỷ, triệu, trăm, ngàn)
==> Đối với số tròn 000 (tức có 3 số 0 đằng sau thì sẽ ra luôn kết quả k như ý: có dấu phẩy trước chữ "đồng" ~ ", đồng")
Vậy phải có thêm câu lệnh xóa dấu phẩy vô duyên trước chữ đồng này đi là OK.
- Thêm 1 câu lệnh giữa dòng lệnh số 69 và 70 như sau:
vnd = Replace(vnd, ", " & ChrW(273) & ChrW(7891) & "ng.", " " & ChrW(273) & ChrW(7891) & "ng.")
(câu lệnh này mục đích thay thếchuỗi ", đồng" thành chuỗi "đồng" - bỏ dấu phẩy trong kết quả của đọc chữ số là xong.)
Code đầy đủ sau khi sửa như trên:
[Visual Basic] 纯文本查看 复制代码
Function vnd(conso) As String
Dim nSheet As String
nSheet = ActiveSheet.Name
If nSheet <> "VLHT XD" And nSheet <> "VLHT TB" Then
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
vnd = ""
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"
ElseIf n3 = 4 And n2 <> 1 And n2 <> 4 And n1 = 4 Then S3 = " t" & ChrW(432)
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
vnd = UCase(Left(dau & Trim(docso), 1)) & Mid(dau & Trim(docso), 2) & " " & ChrW(273) & ChrW(7891) & "ng."
vnd = Replace(vnd, ", " & ChrW(273) & ChrW(7891) & "ng.", " " & ChrW(273) & ChrW(7891) & "ng.")
If Left(vnd, 2) = "T" & ChrW(432) Then
vnd = "B" & ChrW(7889) & "n" & Right(vnd, (Len(vnd) - 2))
End If
Else
'vnd = conso
End If
End If
End Function
Tác giả: tranhoe Thời gian: 27/8/2016 10:35
Sau khi nghiên cứu, không dùng biện pháp thay thế mà xử lý triệt để tại những vị trí "000".
Chạy thử xem có bị gì không nhé!
[Visual Basic] 纯文本查看 复制代码
Function vnd(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))
If Trim(conso) = "" Then
vnd = ""
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
If Right$(docso, 1) = "," Then docso = Left$(docso, Len(docso) - 1)
s123 = " t" & ChrW(7927)
Else
s123 = ""
End If
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"
ElseIf n3 = 4 And n2 <> 1 And n2 <> 4 And n1 = 4 Then S3 = " t" & ChrW(432)
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 Right$(docso, 1) = "," Then docso = Left$(docso, Len(docso) - 1)
vnd = UCase(Left(dau & Trim(docso), 1)) & Mid(dau & Trim(docso), 2) & " " & ChrW(273) & ChrW(7891) & "ng."
If Left(vnd, 2) = "T" & ChrW(432) Then
vnd = "B" & ChrW(7889) & "n" & Right(vnd, (Len(vnd) - 2))
End If
End If
End Function
Tác giả: butua@vn Thời gian: 27/8/2016 10:48
Rất cảm ơn chú và các anh đã giúp đỡ;
Với Code này cháu vẫn thấy chưa ưng ý lắm, mặc dù cũng ít bao giờ làm việc với giá trị >1000 tỷ đồng.
Dẫn chứng: Với giá trị bắt đầu lớn hơn 1000 tỷ, cụ thể là 1001 tỷ trở đi thì code đọc như sau: "Một nghìn, không trăm linh một tỷ đồng." như thế này chắc có vẻ không hợp lý bằng "Một nghìn không trăm linh một tỷ đồng." (bỏ dấu phảy hàng nghìn khi giá trị lớn hơn 1000 tỷ thì sẽ hợp lý ạ)
Thanks !
Tác giả: tranhoe Thời gian: 27/8/2016 15:20
Vậy thì xài tiếp file này đi:
Ham doc tien bang chu UNI.xls
(33.5 KB, Lượt tải về: 606)