Rất rất cần hàm dịch số ra chữ hoàn chỉnh

  • Thread starter tungbv
  • Ngày gửi
T

tungbv

Thành viên sơ cấp
11/8/06
2
0
0
43
Hoa Binh
#1
Mình đã dùng 1 số phần hướng dẫn chuyển số ra chữ như trong diễn đàn và đã làm được. Nhưng hiện đang gặp phải 1 vấn đề các nơi giao dịch chuyển tiền không chấp nhận cách viết bằng chữ đó:
Nếu số tiền là: 123450 thì dịch ra là: Một trăm hai mươi ba ngàn bốn trăm năm mươi đồng chẵn. OK
Nhưng khi số tiền là: 120004 thì chỉ dịch là: Một trăm hai mươi ngàn bốn đồng. Như thế người ta không chấp nhận. Dịch đúng phải là: Một trăm hai mươi ngàn không trăm linh bốn đồng
Hoặc 120040 phải dịch là Một trăm hai mươi ngàn không trăm bốn mươi đồng chẵn chứ không được dịch Một trăm hai mươi ngàn bốn mươi đồng chẵn
Vì tôi chuyển qua word nên cần phải dịch ra o dạng font unicode
Có ai giúp mình chuyển ra chữ đầy đủ với. Cảm ơn các bạn
Emai ketoanbv@yahoo.com
 
Sửa lần cuối:
L

Longlv

Thành viên sơ cấp
21/10/05
44
1
8
41
Hanoi
#2
Bạn thử hàm sau xem :

Function WriteVN(num As Currency) As String
Dim deci(), ll, w, w1 As String
Dim x, y, z, t, j, k As Long
Dim a(), q, donvi(), chuc(), tram(), xu, hao As Integer

y = Abs(num)
x = Fix(y)
q = Fix((y - x) * 100)
z = Len(x)
xu = q Mod 10
hao = q \ 10 Mod 10
If q = 0 Then
w1 = w1
Else
End If
If z <> 3 * Int(z / 3) Then
t = Int(z / 3) + 1
Else
t = Int(z / 3)
End If
ReDim a(1 To t)
If z = 1 Then
a(1) = Val(Mid(x, 1, 1))
End If
If z = 2 Then
a(1) = Val(Mid(x, 1, 2))
End If
If z = 3 * Int(z / 3) Then
For j = 1 To t
a(j) = Val(Mid(x, z + 1 - j * 3, 3))
Next j
End If
If z = 3 * Int(z / 3) + 1 And t > 1 Then
a(t) = Val(Mid(x, 1, 1))
For j = 2 To t
a(j - 1) = Val(Mid(x, z + 4 - j * 3, 3))
Next j
End If
If z = 3 * Int(z / 3) + 2 And t > 1 Then
a(t) = Val(Mid(x, 1, 2))
For j = 2 To t
a(j - 1) = Val(Mid(x, z + 4 - j * 3, 3))
Next j
End If
ReDim deci(1 To 5)
deci(1) = "": deci(2) = " ngh×n"
deci(3) = " triÖu": deci(4) = " tû"

If t = 5 Then
If a(t - 1) = 0 Then
deci(5) = " ngh×n tû"
Else
deci(5) = " ngh×n"
End If
End If
ReDim donvi(1 To t)
ReDim chuc(1 To t)
ReDim tram(1 To t)
For k = 1 To t
donvi(k) = a(k) Mod 10
chuc(k) = a(k) \ 10 Mod 10
tram(k) = a(k) \ 100
If a(k) <> 0 Then
w = deci(k) + w
Select Case donvi(k)
Case 1
If chuc(k) > 1 Then
w = " mèt" + w
Else
w = " mét" + w
End If
Case 2: w = " hai" + w
Case 3: w = " ba" + w
Case 4
If chuc(k) = 1 Or (chuc(k) = 0 And tram(k) = 0) Then
w = " bèn" + w
Else
w = " t&shy;" + w
End If
Case 5
If chuc(k) = 0 Then
w = " n¨m" + w
Else
w = " l¨m" + w
End If
Case 6: w = " s¸u" + w
Case 7: w = " b¶y" + w
Case 8: w = " t¸m" + w
Case 9: w = " chÝn" + w
End Select
Select Case chuc(k)
Case 1: w = " m&shy;êi" + w
Case 2: w = " hai m&shy;¬i" + w
Case 3: w = " ba m&shy;¬i" + w
Case 4: w = " bèn m&shy;¬i" + w
Case 5: w = " n¨m m&shy;¬i" + w
Case 6: w = " s¸u m&shy;¬i" + w
Case 7: w = " b¶y m&shy;¬i" + w
Case 8: w = " t¸m m&shy;¬i" + w
Case 9: w = " chÝn m&shy;¬i " + w
Case 0
If tram(k) <> 0 And donvi(k) <> 0 Then
w = " linh" + w
End If
End Select
Select Case tram(k)
Case 1: w = " mét tr¨m" + w
Case 2: w = " hai tr¨m" + w
Case 3: w = " ba tr¨m" + w
Case 4: w = " bèn tr¨m" + w
Case 5: w = " n¨m tr¨m" + w
Case 6: w = " s¸u tr¨m" + w
Case 7: w = " b¶y tr¨m" + w
Case 8: w = " t¸m tr¨m" + w
Case 9: w = " chÝn tr¨m" + w
Case 0
If t > k And chuc(k) = 0 Then
w = " kh«ng tr¨m linh" + w
End If

If t > k And chuc(k) <> 0 Then
w = " kh«ng tr¨m" + w
End If

End Select
Else
w = w
End If
Next k
ll = LTrim(w)
If num < 0 Then
WriteVN = " ¢m " & ll & " ®ång" & w1 & "."
WriteVN = Replace(WriteVN, " ", " ")
WriteVN = Replace(WriteVN, " ", " ")
Else
WriteVN = "" & UCase(Left(ll, 1)) & Mid(ll, 2, Len(ll) - 1) & " ®ång ch½n" & w1 & "."
WriteVN = Replace(WriteVN, " ", " ")
WriteVN = Replace(WriteVN, " ", " ")
End If

End Function
 
T

tungbv

Thành viên sơ cấp
11/8/06
2
0
0
43
Hoa Binh
#3
Trả lời

Tôi đã chuyển được sang fonr unicode roiif, tuy nhien còn chữ "tỷ" tôi không chuyển được mong các bạn sửa lại mã chữ "tỷ" bằng unicode cho tôi

Function Tung(num As Currency) As String
Dim deci(), ll, w, w1 As String
Dim x, y, z, t, J, k As Long
Dim a(), q, donvi(), chuc(), tram(), xu, hao As Integer

y = Abs(num)
x = Fix(y)
q = Fix((y - x) * 100)
z = Len(x)
xu = q Mod 10
hao = q \ 10 Mod 10
If q = 0 Then
w1 = w1
Else
End If
If z <> 3 * Int(z / 3) Then
t = Int(z / 3) + 1
Else
t = Int(z / 3)
End If
ReDim a(1 To t)
If z = 1 Then
a(1) = Val(Mid(x, 1, 1))
End If
If z = 2 Then
a(1) = Val(Mid(x, 1, 2))
End If
If z = 3 * Int(z / 3) Then
For J = 1 To t
a(J) = Val(Mid(x, z + 1 - J * 3, 3))
Next J
End If
If z = 3 * Int(z / 3) + 1 And t > 1 Then
a(t) = Val(Mid(x, 1, 1))
For J = 2 To t
a(J - 1) = Val(Mid(x, z + 4 - J * 3, 3))
Next J
End If
If z = 3 * Int(z / 3) + 2 And t > 1 Then
a(t) = Val(Mid(x, 1, 2))
For J = 2 To t
a(J - 1) = Val(Mid(x, z + 4 - J * 3, 3))
Next J
End If
ReDim deci(1 To 5)
deci(1) = "": deci(2) = " ng" & ChrW$(224) & "n"
deci(3) = " tri" & ChrW$(7879) & "u": deci(4) = " t" & ChrW$(272)

If t = 5 Then
If a(t - 1) = 0 Then
deci(5) = " ngh×n tû"
Else
deci(5) = " ng" & ChrW$(224) & "n"
End If
End If
ReDim donvi(1 To t)
ReDim chuc(1 To t)
ReDim tram(1 To t)
For k = 1 To t
donvi(k) = a(k) Mod 10
chuc(k) = a(k) \ 10 Mod 10
tram(k) = a(k) \ 100
If a(k) <> 0 Then
w = deci(k) + w
Select Case donvi(k)
Case 1
If chuc(k) > 1 Then
w = " m" & ChrW$(7889) & "t" + w
Else
w = " m" & ChrW$(7897) & "t" + w
End If
Case 2: w = " hai" + w
Case 3: w = " ba" + w
Case 4
If chuc(k) = 1 Or (chuc(k) = 0 And tram(k) = 0) Then
w = " b" & ChrW$(7889) & "n " + w
Else
w = " t&shy;" + w
End If
Case 5
If chuc(k) = 0 Then
w = " n" & ChrW$(259) & "m " + w
Else
w = " l" & ChrW$(259) & "m" + w
End If
Case 6: w = " s" & ChrW$(225) & "u" + w
Case 7: w = " b" & ChrW$(7849) & "y" + w
Case 8: w = " t" & ChrW$(225) & "m " + w
Case 9: w = " ch" & ChrW$(237) & "n" + w
End Select
Select Case chuc(k)
Case 1: w = " m" & ChrW$(432) & ChrW$(7901) & "i" + w
Case 2: w = " hai m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 3: w = " ba m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 4: w = " b" & ChrW$(7889) & "n m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 5: w = " n" & ChrW$(259) & "m m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 6: w = " s" & ChrW$(225) & "u m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 7: w = " b" & ChrW$(7849) & "y m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 8: w = " t " & ChrW$(225) & "m m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 9: w = " ch" & ChrW$(237) & "n m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 0
If tram(k) <> 0 And donvi(k) <> 0 Then
w = " linh" + w
End If
End Select
Select Case tram(k)
Case 1: w = " m" & ChrW$(7897) & "t tr" & ChrW$(259) & "m" + w
Case 2: w = " hai tr" & ChrW$(259) & "m" + w
Case 3: w = " ba tr" & ChrW$(259) & "m" + w
Case 4: w = " b" & ChrW$(7889) & "n tr" & ChrW$(259) & "m" + w
Case 5: w = " n" & ChrW$(259) & "m tr" & ChrW$(259) & "m" + w
Case 6: w = " s" & ChrW$(225) & "u tr" & ChrW$(259) & "m" + w
Case 7: w = " b" & ChrW$(7849) & "y tr" & ChrW$(259) & "m" + w
Case 8: w = " t" & ChrW$(225) & "m tr" & ChrW$(259) & "m" + w
Case 9: w = " ch" & ChrW$(237) & "n tr" & ChrW$(259) & "m" + w
Case 0
If t > k And chuc(k) = 0 Then
w = " kh" & ChrW$(244) & "ng tr" & ChrW$(259) & "m linh" + w
End If

If t > k And chuc(k) <> 0 Then
w = " kh" & ChrW$(244) & "ng tr" & ChrW$(259) & "m" + w
End If

End Select
Else
w = w
End If
Next k
ll = LTrim(w)
If num < 0 Then
Tung = " ¢m " & ll & ChrW$(273) & ChrW$(7891) & "ng" & w1 & "."
Tung = Replace(Tung, " ", " ")
Tung = Replace(Tung, " ", " ")
Else
Tung = "" & UCase(Left(ll, 1)) & Mid(ll, 2, Len(ll) - 1) & " " & ChrW$(273) & ChrW$(7891) & "ng ch" & ChrW$(7861) & "n " & w1 & "."
Tung = Replace(Tung, " ", " ")
Tung = Replace(Tung, " ", " ")
End If

End Function
 
D

doremon1028

Thành viên sơ cấp
14/6/06
8
0
1
Ha Noi
#4
Mình ko biết cách làm như của các bạn, mình có xem trong diễn đàn cách đổi chữ ra số và cũng gặp TH giống như Tungbv. Cách đổi chữ ra số mà mình xem được là các bạn dùng hàm UPPER(LEFT(TRIM(IF.....
Các bạn có thể giúp mình giải quyết vấn đề này với.
Nếu có thể xin gửi qua địa chỉ mail: doremon1028@yahoo.com cho mình.
Xin chân thành cảm ơn.
 
T

thainc

Thành viên sơ cấp
14/9/06
2
0
0
49
hcm
#6
tungbv nói:
Mình đã dùng 1 số phần hướng dẫn chuyển số ra chữ như trong diễn đàn và đã làm được. Nhưng hiện đang gặp phải 1 vấn đề các nơi giao dịch chuyển tiền không chấp nhận cách viết bằng chữ đó:
Nếu số tiền là: 123450 thì dịch ra là: Một trăm hai mươi ba ngàn bốn trăm năm mươi đồng chẵn. OK
Nhưng khi số tiền là: 120004 thì chỉ dịch là: Một trăm hai mươi ngàn bốn đồng. Như thế người ta không chấp nhận. Dịch đúng phải là: Một trăm hai mươi ngàn không trăm linh bốn đồng
Hoặc 120040 phải dịch là Một trăm hai mươi ngàn không trăm bốn mươi đồng chẵn chứ không được dịch Một trăm hai mươi ngàn bốn mươi đồng chẵn
Vì tôi chuyển qua word nên cần phải dịch ra o dạng font unicode
Có ai giúp mình chuyển ra chữ đầy đủ với. Cảm ơn các bạn
Emai ketoanbv@yahoo.com
Xem thử cái này coi!
http://nguyencaothai.5u.com
hay http://caothaidhsp.topcities.com/huongdan.htm
 
Sửa lần cuối:
T

thuyquan

Thành viên sơ cấp
26/8/06
39
1
0
38
Da Lat
#7
cảm ơn anh Thái, nhưng...

Trước tiên, thay mặt cho những người ... "chỉ biết dùng" và "hay thắc mắc" chân thành cảm ơn Anh Thái đã cung cung một chương trình khá hay và hữu ích cho dân KT!
Sau khi cài đặt, em chạy thử thì gặp trục trặt rồi anh ui!
em gõ =Ho("Nguyễn Hoàng Việt" thì chỉ ra được chữ "Nguyễn" thôi
hoten(font Arial) họ tên
Nguyễn Hoàng Việt Nguyễn Việt
Vậy là sao hả anh, trong khi ở Sampe tải về em thấy anh làm được mừ. Giúp em với nha.
Nếu có thể, anh mail cho em theo: cromatic_hg@yahoo.com.vn nhé. "Thanh kiều ve ri mút"
 
O

ochuchoa

Thành viên sơ cấp
14/7/05
12
0
0
Da nang
#9
thuyquan nói:
Trước tiên, thay mặt cho những người ... "chỉ biết dùng" và "hay thắc mắc" chân thành cảm ơn Anh Thái đã cung cung một chương trình khá hay và hữu ích cho dân KT!
Sau khi cài đặt, em chạy thử thì gặp trục trặt rồi anh ui!
em gõ =Ho("Nguyễn Hoàng Việt" thì chỉ ra được chữ "Nguyễn" thôi
hoten(font Arial) họ tên
Nguyễn Hoàng Việt Nguyễn Việt
Vậy là sao hả anh, trong khi ở Sampe tải về em thấy anh làm được mừ. Giúp em với nha.
Nếu có thể, anh mail cho em theo: cromatic_hg@yahoo.com.vn nhé. "Thanh kiều ve ri mút"
Phần đổi số ra chữ cũng có một lỗi nho nhỏ là sau chữ đồng vẫn còn chữ xu, cho dù không phải là số lẻ.
Nghe "một trăm đồng xu" lạ tai quá xá hê hê
Anh Thái sửa lại giúp anh em nhé vì file VBA có pw, có gì mail giúp ochuchoa về địa chỉ admin.spm@gmail.com
Cảm ơn rất nhiều
 
O

ochuchoa

Thành viên sơ cấp
14/7/05
12
0
0
Da nang
#10
tungbv nói:
Tôi đã chuyển được sang fonr unicode roiif, tuy nhien còn chữ "tỷ" tôi không chuyển được mong các bạn sửa lại mã chữ "tỷ" bằng unicode cho tôi

Function Tung(num As Currency) As String
Dim deci(), ll, w, w1 As String
Dim x, y, z, t, J, k As Long
Dim a(), q, donvi(), chuc(), tram(), xu, hao As Integer

y = Abs(num)
x = Fix(y)
q = Fix((y - x) * 100)
z = Len(x)
xu = q Mod 10
hao = q \ 10 Mod 10
If q = 0 Then
w1 = w1
Else
End If
If z <> 3 * Int(z / 3) Then
t = Int(z / 3) + 1
Else
t = Int(z / 3)
End If
ReDim a(1 To t)
If z = 1 Then
a(1) = Val(Mid(x, 1, 1))
End If
If z = 2 Then
a(1) = Val(Mid(x, 1, 2))
End If
If z = 3 * Int(z / 3) Then
For J = 1 To t
a(J) = Val(Mid(x, z + 1 - J * 3, 3))
Next J
End If
If z = 3 * Int(z / 3) + 1 And t > 1 Then
a(t) = Val(Mid(x, 1, 1))
For J = 2 To t
a(J - 1) = Val(Mid(x, z + 4 - J * 3, 3))
Next J
End If
If z = 3 * Int(z / 3) + 2 And t > 1 Then
a(t) = Val(Mid(x, 1, 2))
For J = 2 To t
a(J - 1) = Val(Mid(x, z + 4 - J * 3, 3))
Next J
End If
ReDim deci(1 To 5)
deci(1) = "": deci(2) = " ng" & ChrW$(224) & "n"
deci(3) = " tri" & ChrW$(7879) & "u": deci(4) = " t" & ChrW$(7927)

If t = 5 Then
If a(t - 1) = 0 Then
deci(5) = " ngh×n tû"
Else
deci(5) = " ng" & ChrW$(224) & "n"
End If
End If
ReDim donvi(1 To t)
ReDim chuc(1 To t)
ReDim tram(1 To t)
For k = 1 To t
donvi(k) = a(k) Mod 10
chuc(k) = a(k) \ 10 Mod 10
tram(k) = a(k) \ 100
If a(k) <> 0 Then
w = deci(k) + w
Select Case donvi(k)
Case 1
If chuc(k) > 1 Then
w = " m" & ChrW$(7889) & "t" + w
Else
w = " m" & ChrW$(7897) & "t" + w
End If
Case 2: w = " hai" + w
Case 3: w = " ba" + w
Case 4
If chuc(k) = 1 Or (chuc(k) = 0 And tram(k) = 0) Then
w = " b" & ChrW$(7889) & "n " + w
Else
w = " t&shy;" + w
End If
Case 5
If chuc(k) = 0 Then
w = " n" & ChrW$(259) & "m " + w
Else
w = " l" & ChrW$(259) & "m" + w
End If
Case 6: w = " s" & ChrW$(225) & "u" + w
Case 7: w = " b" & ChrW$(7849) & "y" + w
Case 8: w = " t" & ChrW$(225) & "m " + w
Case 9: w = " ch" & ChrW$(237) & "n" + w
End Select
Select Case chuc(k)
Case 1: w = " m" & ChrW$(432) & ChrW$(7901) & "i" + w
Case 2: w = " hai m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 3: w = " ba m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 4: w = " b" & ChrW$(7889) & "n m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 5: w = " n" & ChrW$(259) & "m m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 6: w = " s" & ChrW$(225) & "u m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 7: w = " b" & ChrW$(7849) & "y m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 8: w = " t " & ChrW$(225) & "m m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 9: w = " ch" & ChrW$(237) & "n m" & ChrW$(432) & ChrW$(417) & "i" + w
Case 0
If tram(k) <> 0 And donvi(k) <> 0 Then
w = " linh" + w
End If
End Select
Select Case tram(k)
Case 1: w = " m" & ChrW$(7897) & "t tr" & ChrW$(259) & "m" + w
Case 2: w = " hai tr" & ChrW$(259) & "m" + w
Case 3: w = " ba tr" & ChrW$(259) & "m" + w
Case 4: w = " b" & ChrW$(7889) & "n tr" & ChrW$(259) & "m" + w
Case 5: w = " n" & ChrW$(259) & "m tr" & ChrW$(259) & "m" + w
Case 6: w = " s" & ChrW$(225) & "u tr" & ChrW$(259) & "m" + w
Case 7: w = " b" & ChrW$(7849) & "y tr" & ChrW$(259) & "m" + w
Case 8: w = " t" & ChrW$(225) & "m tr" & ChrW$(259) & "m" + w
Case 9: w = " ch" & ChrW$(237) & "n tr" & ChrW$(259) & "m" + w
Case 0
If t > k And chuc(k) = 0 Then
w = " kh" & ChrW$(244) & "ng tr" & ChrW$(259) & "m linh" + w
End If

If t > k And chuc(k) <> 0 Then
w = " kh" & ChrW$(244) & "ng tr" & ChrW$(259) & "m" + w
End If

End Select
Else
w = w
End If
Next k
ll = LTrim(w)
If num < 0 Then
Tung = " ¢m " & ll & ChrW$(273) & ChrW$(7891) & "ng" & w1 & "."
Tung = Replace(Tung, " ", " ")
Tung = Replace(Tung, " ", " ")
Else
Tung = "" & UCase(Left(ll, 1)) & Mid(ll, 2, Len(ll) - 1) & " " & ChrW$(273) & ChrW$(7891) & "ng ch" & ChrW$(7861) & "n " & w1 & "."
Tung = Replace(Tung, " ", " ")
Tung = Replace(Tung, " ", " ")
End If

End Function
Hàm này tuyệt vời, tớ đã sửa được chữ tỷ, cảm ơn :))
 

Thành viên trực tuyến

  • huonghvtc89
  • HT Hòa
  • daongocnam0603
  • HoangAnhPhong411
  • kimLETUANKIM

Xem nhiều