Xin giúp đỡ về hàm đếm số (1 người xem)

[quangtuanbs]

Xin giúp đỡ về hàm chuyển số tiền thành chữ

Chào các bạn và các thầy. Em có 1 công thức vba chuyển số thành chữ. tuy nhiên có một lỗi nhỏ em không biết khắc phục như thế nào.
1. với số tiền từ 10 trđ đến dưới 20 triệu đồng thì chữ cái đầu tiên của nó viết thường
- ví dụ: 10 trđ nó viết là "mười triệu đồng" chứ không phải là "Mười triệu đồng"
2. với số tiền >2,1 tỉ đồng thì nó không chuyển thành chữ được
- ví dụ: 2,2 tỉ đồng thì nó không đọc được
Mong các bạn và các thầy giúp em khắc phục 2 nhược điểm trên với ạ.
Ngoài ra em có một mong muốn là mong các bạn và các thầy giúp em khi số tiền tròn từ triệu trở lên thì nó sẽ đọc là "chẵn" ở cuối câu
- ví dụ: 2.000.000 , bằng chữ là "Hai triệu đồng chẵn"
bình thường em dùng hàm để tạo ra từ chẵn đó như sau:
=if(value(Right(B10;6))<1;transfer(B10)&" chẵn";transfer(B10))
Em xin cảm ơn mọi người, code của VBA đó như sau:

Function transfer(num As Long) As StringDim reval As String
Dim mival As String
Dim n As Integer
Dim i As Integer
Dim val1 As String
Dim val2 As String
Dim val3 As String
Dim kt As Integer
Dim rkt As Integer
Dim dv As String
Dim test As String
Dim fr As String
mival = CStr(Abs(num))
n = Len(mival)
reval = ""
dv = ""
For i = n To 1 Step -1
val1 = substr(mival, n - i + 1, 1)
val2 = IIf(i > 1, substr(mival, n - i + 2, 1), "0")
val3 = IIf(i > 2, substr(mival, n - i + 3, 1), "0")
fr = IIf(i >= n - 1, "##", substr(mival, n - i - 1, 2))
test = fr + val1
rkt = i Mod 3
kt = IIf(rkt >= 0, rkt, rkt + 3)
Select Case kt
Case 0
If val1 <> "0" Then
reval = reval + doi(val1) + " tr¨m " + IIf(val2 = "0" And val3 <> "0", " linh ", "")
End If
Case 2
If val1 <> "0" Then
reval = reval + IIf(val1 = "1", " m­êi ", doi(val1) + " m­¬i ")
End If
Case 1
If val1 <> "0" Then
reval = reval + doi(val1) + " "
End If
If i / 3 <= 1 Then
dv = "®ång"
End If
If i / 3 > 1 And i / 3 <= 2 Then
dv = IIf(test = "000", "", "ngµn")
End If
If i / 3 > 2 And i / 3 <= 3 Then
dv = IIf(test = "000", "", "triÖu")
End If
If i / 3 > 3 Then
dv = "tû"
End If
reval = reval + dv + " "
End Select
Next i
transfer = IIf(num < 0, "©m " & reval, reval)
transfer = UCase(Left(transfer, 1)) & Right(transfer, Len(transfer) - 1)
End Function
Function doi(num As String) As String
Dim myval As String
Select Case num
Case "1"
myval = "mét"
Case "2"
myval = "hai"
Case "3"
myval = "ba"
Case "4"
myval = "bèn"
Case "5"
myval = "n¨m"
Case "6"
myval = "s¸u"
Case "7"
myval = "bÈy"
Case "8"
myval = "t¸m"
Case "9"
myval = "chÝn"
End Select
doi = myval
End Function
Function substr(mystr As String, posi As Integer, count As Integer) As String
Dim myval As String
myval = Right(Left(mystr, posi + count - 1), count)
substr = myval
End Function

Ah nếu có thể thì em mong mọi người giúp em làm một code tương tự nhưng là font Unicode, hiện nó là font TCVN3

 

[baduyst]

Mình có thử nhưng nó lại phát sinh một số lỗi khác.
Đành nhờ và các thầy và các bạn khác giúp bạn vậy.
Mọi người giúp đỡ bạn ấy nhé.

 

[quangtuanbs]

Híc, cái này khó lắm ah sao không thấy ai giúp mình thế

 

[Ba Tê]

Híc, cái này khó lắm ah sao không thấy ai giúp mình thế

Không phải là quá khó, mà vì trên GPE đã có "nhóc", bạn tìm trên GPE ví dụ với từ khóa "Đọc số thành chữ Unicode" sẽ có "nhóc thiệt"; đọc, xem, thử, và chọn cái nào ưng ý nhất tải về mà xài.
Ví dụ địa chỉ này, bắt đầu từ 2006:
http://www.giaiphapexcel.com/forum/...ng-Excel-sử-dụng-font-Unicode&p=6106#post6106