Tôi muốn chia sẻ với các bạn một hàm đọc số tiền trong Excel. Đây không phải là một hàm thông thường, nó có các điểm mạnh sau:
- Đọc được số lớn tới 1 tỷ tỷ
- Đọc được số tiền lẻ, phân biệt chẵn lẻ.
- Đọc theo nhiều loại ngoại tệ (thêm tham số thứ hai là loại tiền tệ như "VND", "USD", "EUR",... vào khi gọi hàm)
- Và nhiều điều kỳ diệu khác chờ các bạn khám phá
Các bạn chỉ việc mở Excel, vào menu Tool -> Macro -> Visual Basic Editor -> Insert -> Module, sau đó copy và paste đoạn code sau vào:
Public Function SayMoney(ByVal dblNumber As Double, Optional ByVal sCurrencyID As String = "®ång") As String
On Error GoTo ErrorHandle
Const cstMaxNumber = 999999999999999#
Const cstMaxDecimalNumber = 9999999999999.99
If dblNumber > cstMaxNumber Then
SayMoney = ""
Exit Function
End If
If (dblNumber - Round(dblNumber, 0) <> 0) And sCurrencyID <> "VND" Then
If dblNumber > cstMaxDecimalNumber Then
SayMoney = ""
Exit Function
End If
End If
Dim sUnit As String
Dim sAfterUnit As String
sUnit = ""
sAfterUnit = ""
Select Case sCurrencyID
Case "VND", "®ång"
sUnit = "®ång"
sAfterUnit = "xu"
Case "USD"
sUnit = "®« la Mü"
sAfterUnit = "xen"
Case "EUR"
sUnit = "euro"
Case "FRF"
sUnit = "phê r¨ng"
sAfterUnit = "xi linh"
Case "JPY"
sUnit = "yªn"
Case "GBP"
sUnit = "b¶ng"
sAfterUnit = "pence"
Case "CNY"
sUnit = "nh©n d©n tÖ"
Case Else
sUnit = sCurrencyID
End Select
If sCurrencyID = "VND" Then
dblNumber = Abs(Round(dblNumber, 0))
Else
dblNumber = Abs(Round(dblNumber, 2))
End If
'Define some useful mem-var for translating
Dim zk(1 To 9) As String
Dim zd(1 To 18) As String
Dim ttien As String, zkt As String, zv As String
Dim zi As Integer, zj As Integer, i As Integer
zk(1) = "mét"
zk(2) = "hai"
zk(3) = "ba"
zk(4) = "bèn"
zk(5) = "n¨m"
zk(6) = "s¸u"
zk(7) = "b¶y"
zk(8) = "t¸m"
zk(9) = "chÝn"
zd(15) = sUnit
zd(18) = sAfterUnit
zd(6) = "tû"
zd(9) = "triÖu"
For i = 3 To 12 Step 9
zd(i) = "ngh×n"
Next
For i = 1 To 13 Step 3
zd(i) = "tr¨m"
Next
For i = 2 To 17 Step 3
zd(i) = "m¬i"
Next
ttien = " "
zkt = CStr(Format(dblNumber, "#.00"))
For i = 1 To 18 - Len(zkt)
zkt = " " & zkt
Next
zi = 19 - Len(LTrim(zkt))
'Translating
Do While zi < 19
zv = Mid(zkt, zi, 1)
If InStr(1, "0123456789", zv, vbTextCompare) And zv <> "" Then
zj = CInt(LTrim(CStr(zi)))
If zv = "0" Then
If (zi = 13 Or zi = 10 Or zi = 7 Or zi = 4 Or zi = 1) And (Val(Mid(zkt, zi + 1, 1)) <> 0 Or Val(Mid(zkt, zi + 2, 1)) <> 0) Then
ttien = ttien + " kh«ng tr¨m"
If Mid(zkt, zi + 1, 1) = "0" Then
ttien = ttien + " linh"
End If
ElseIf zi = 18 And Val(Mid(zkt, 17, 1)) > 0 Then
ttien = ttien + " " & sAfterUnit
ElseIf zd(zj) = "m¬i" And Val(Mid(zkt, zi + 1, 1)) > 0 And Val(Mid(zkt, IIf(zi > 1, zi - 1, 19), 1)) > 0 Then
ttien = ttien + " linh"
ElseIf zi = 6 Or (zi = 15 And dblNumber >= 1) Or ((zi = 3 Or zi = 9 Or zi = 12) And Mid(zkt, IIf(zi > 2, zi - 2, 19), 2) <> "00") Then
ttien = ttien + " " + zd(zj)
End If
ElseIf zv = "1" And zd(zj) = "m¬i" Then
ttien = ttien + " mêi"
ElseIf zv = "5" And Val(Mid(zkt, IIf(zi > 1, zi - 1, 19), 1)) > 0 And (zi = 3 Or zi = 6 Or zi = 9 Or zi = 12 Or zi = 15 Or zi = 18) Then
ttien = ttien + " l¨m " + zd(zj)
Else
ttien = ttien + " " + zk(CInt(zv)) + " " + zd(zj)
End If
End If
zi = zi + 1
Loop
ttien = Replace(ttien, "m¬i mét", "m¬i mèt", , , vbTextCompare)
ttien = Replace(ttien, "m¬i bèn", "m¬i t", , , vbTextCompare)
ttien = UCase(Mid(ttien, 3, 1)) + Mid(ttien, 4)
If Int(dblNumber) - dblNumber = 0 Then
ttien = ttien + " ch½n"
End If
SayMoney = ttien
Exit Function
ErrorHandle:
SayMoney = ""
Err.Clear
End Function
