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

Guest
11/8/06
2
0
0
49
Hoa Binh
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:
Khóa học Quản trị dòng tiền
L

Longlv

Sơ cấp
21/10/05
44
1
8
47
Hanoi
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

Guest
11/8/06
2
0
0
49
Hoa Binh
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

Guest
14/6/06
8
0
1
Ha Noi
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

Guest
14/9/06
2
0
0
54
hcm
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
Nhấn để mở rộng...
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

Guest
26/8/06
39
1
0
43
Da Lat
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

Guest
14/7/05
12
0
0
Da nang
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"
Nhấn để mở rộng...

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

Guest
14/7/05
12
0
0
Da nang
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
Nhấn để mở rộng...

Hàm này tuyệt vời, tớ đã sửa được chữ tỷ, cảm ơn :))
 
Bạn phải đăng nhập hoặc đăng ký để bình luận.

Similar threads

qthuyhien
Du lịch Đà Lạt chắc chắn sẽ khiến bạn vui vẻ và thoải mái
Trả lời
0
Lượt xem
12
Quảng cáo, rao vặt
qthuyhien
qthuyhien
T
Chuyển đổi số cho thư viện trường học
Trả lời
1
Lượt xem
52K
FAQ - Hỏi đáp về Tin học
minhuv
M
Sonpogba
Thu hút khách hàng Hàn Quốc
Trả lời
0
Lượt xem
16
Quảng cáo, rao vặt
Sonpogba
Sonpogba
Sonpogba
THU HÚT KHÁCH HÀNG HÀN QUỐC NHƯ THẾ NÀO ?
Trả lời
0
Lượt xem
20
Quảng cáo, rao vặt
Sonpogba
Sonpogba
Sonpogba
Quảng cáo thị trường Hàn Quốc
Trả lời
0
Lượt xem
21
Quảng cáo, rao vặt
Sonpogba
Sonpogba

Xem nhiều

Liên kết

Dịch vụ kế toán Tâm An kế toán quản trị

Chia sẻ trang

Share this page
Webketoan Zalo OA
Top Bottom