Gửi mọi người 1 hàm đọc số mới

[anhkietvn]

Đã lâu rồi mình không có đóng góp gì cho GPE, nay xin gửi đến anh em hàm đổi số ra chữ này mình viết cũng khá lâu rồi theo cách viết của mình, chắc cũng gần 10 năm nay, hàm này lúc đầu mình viết trên VB, sau đó chuyển sang VBA thấy chạy cũng rất good, nay post lên đây cho mọi người tham khảo.
Ah, hàm này mình viết cho dạng font 1 byte, nếu ai rảnh xin chuyển sang dạng font 2 byte và unicode giúp mình nha

Code VBA:

' Ham chuyen so ---> chu so (vd: 123 ----> mot tram hai muoi ba)
' Ten ham: Number2String
' Input:
' - mvNumber: kieu variant - la chuoi so can chuyen
' Output:
' - Ham tra ve chuoi da duoc bien dich
Public Function Number2String(ByVal mvNumber) As String
Dim Total As String, Moneys As String
Dim Rows, PosCall, Numberstr
Dim i%, j%, ipos%, S3 As String, TheNum
Dim TheChar As String, TransLate As String

If Val(mvNumber) = 0 Then
Total = "kh«ng ®ång"
Else
If Abs(mvNumber) > 1E+15 Then
Total = "Sè qu¸ lín"
Else
If mvNumber < 0 Then Total = "trõ " Else Total = Space(0)
Moneys = Format(Abs(mvNumber), "##############0.00") ' m­êi t¸m ký sè
Moneys = Right$(Space(15) + Moneys, 18)
Rows = Array("None", "tr¨m ", "m­¬i ", "_?")
PosCall = Array("None", "ngµn tû ", "tû ", "triÖu ", "ngµn ", "®ång ", "xu")
Numberstr = Array("None", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ")
TheNum = Array("None", "1?", "2?", "3?")
For i% = 1 To 6
S3 = Mid(Moneys, i% * 3 - 2, 3)
If S3 <> Space(3) Then
Select Case S3
Case String(3, "0")
If i% = 5 Then TheChar = "®ång " Else TheChar = Space(0)
Case ".00", ",00"
TheChar = "ch½n "
Case Else
TheNum(1) = Left(S3, 1): TheNum(2) = Mid(S3, 2, 1): TheNum(3) = Right(S3, 1)
TheChar = Space(0): Rows(3) = PosCall(i%)
For j% = 1 To 3
TransLate = Space(0)
If TheNum(j%) > "0" Then
TransLate = Numberstr(TheNum(j%)) + Rows(j%)
Else
If (j% = 1) And (i% > 1 And i% < 6) Then
If Val(Mid(Moneys, (i% - 1) * 3 - 2, 3)) > 0 Then TransLate = "kh«ng " + Rows(j%)
End If
End If

Select Case j%
Case 2 And (TheNum(j%) = "1")
TransLate = "m­êi "
Case 3 And (TheNum(j%) = "0") And (S3 <> Space(2) + "0")
TransLate = Rows(j%)
Case 3 And (TheNum(j%) = "5") And (TheNum(2) > "0")
TransLate = "l" + Mid$(TransLate, 2)
Case 2 And (TheNum(j%) = "0") And (TheNum(3) <> "0")
If (i% > 1 And Val(Mid(Moneys, (i% - 1) * 3 - 2, 3)) > 0 Or TheNum(1) > "0") Then
TransLate = "lÎ "
End If
End Select
TheChar = TheChar + TransLate
Next j%
End Select
ipos% = InStr(1, TheChar, "m­¬i mét", vbTextCompare)
If ipos > 0 Then Mid$(TheChar, ipos, 8) = "m­¬i mèt"
Total = Total + TheChar
End If
Next i%
End If
End If
Number2String = UCase$(Left(Total, 1)) + RTrim$(Mid(Total, 2))
End Function

Ah, tiện thể thông tin cho các bạn biết trước, mình đang tổng hợp lại tất cả các hàm tiện ích mà mình đã từng viết + sưu tầm trên internet trong những năm qua thành một bộ hàm tiện ích, hãy đợi đấy nhé

 

[thanhlanh]

Đã lâu rồi mình không có đóng góp gì cho GPE, nay xin gửi đến anh em hàm đổi số ra chữ này mình viết cũng khá lâu rồi theo cách viết của mình, chắc cũng gần 10 năm nay, hàm này lúc đầu mình viết trên VB, sau đó chuyển sang VBA thấy chạy cũng rất good, nay post lên đây cho mọi người tham khảo.
Ah, hàm này mình viết cho dạng font 1 byte, nếu ai rảnh xin chuyển sang dạng font 2 byte và unicode giúp mình nha

Code VBA:

Bạn có thể đặt thêm dấu phẩy vào sau các chữ tỷ, triệu, nghìn; dấu chấm câu và bỏ chữ chẵn cuối cùng cho đẹp được không?

 

[anhkietvn]

Bạn có thể đặt thêm dấu phẩy vào sau các chữ tỷ, triệu, nghìn; dấu chấm câu và bỏ chữ chẵn cuối cùng cho đẹp được không?

Cám ơn ý kiến đóng góp của bạn, nhưng hteo mình nghĩ trên các chứng từ hay hoá đơn không ai viết có dấu phậy ngăn cách cả (VD: mình chưa thấy trên HĐ lại viết: hai mươi ngàn, năm trăm bảy mươi lăm đồng./; mà thường viết liền một câu như thế này:
hai mươi ngàn năm trăm bảy mươi lăm đồng./
còn chữ chẵn cuối câu thì do hồi đó mình viết theo yêu cầu người dùng, nếu bạn không thik có thể sửa lại ở đoạn code này

If i% = 5 Then TheChar = "®ång " Else TheChar = Space(0)
Case ".00", ",00"
TheChar = "ch½n " ' thay phép gán ở đây bằng lệnh TheChar = ""
Case Else ...

còn thêm dấu chấm cuối câu bạn có thể sửa lại tại dòng lệnh này

dòng lệnh cũ: Number2String = UCase$(Left(Total, 1)) + RTrim$(Mid(Total, 2))
dòng lệnh mới: Number2String = UCase$(Left(Total, 1)) + RTrim$(Mid(Total, 2)) + "./"