Thứ Ba, 16 tháng 9, 2008

Thuật toán chuyển từ số sang chữ, dùng trong môi trường Microsoft Office, Visual Basic, ASP, ...

Function Doc_1_chu_so(C As String) As String
Doc_1_chu_so = IIf(C = "0", "khoâng", IIf(C = "1", "moät", IIf(C = "2", "hai", IIf(C = "3", "ba", IIf(C = "4", "boán", IIf(C = "5", "naêm", IIf(C = "6", "saùu", IIf(C = "7", "baûy", IIf(C = "8", "taùm", "chín")))))))))
End Function
Function Doc_3_chu_so(S As String)
Dim ss As String
If S = "000" Then
ss = " "
Else
ss = ""
If Left(S, 1) <> " " Then
ss = ss + Doc_1_chu_so(Left(S, 1)) + " traêm"
End If
If Mid(S, 2, 1) <> " " Then
If Mid(S, 2, 1) = "0" Then
If Mid(S, 3, 1) <> "0" Then
ss = ss + " linh " + Doc_1_chu_so(Mid(S, 3, 1))
End If
Else
If Mid(S, 2, 1) <> "1" Then
ss = ss + " " + Doc_1_chu_so(Mid(S, 2, 1)) + " möôi"
Else
ss = ss + " möôøi"
End If
If Mid(S, 3, 1) <> "0" Then
If Not (Mid(S, 3, 1) = "1" Or Mid(S, 3, 1) = "4" Or Mid(S, 3, 1) = "5") Then
ss = ss + " " + Doc_1_chu_so(Mid(S, 3, 1))
Else
If Mid(S, 3, 1) = "1" Then
If Mid(S, 2, 1) <> "1" Then
ss = ss + " moát"
Else
ss = ss + " moät"
End If
Else
If Mid(S, 3, 1) = "4" And Mid(S, 2, 1) = "1" Then
ss = ss + " boán"
Else
If Mid(S, 3, 1) = "4" Then
ss = ss + " tö"
Else
If Mid(S, 3, 1) = "5" Then
ss = ss + " laêm"
End If
End If
End If
End If
End If
End If
End If
Else
ss = Doc_1_chu_so(Mid(S, 3, 1))
End If
End If
Doc_3_chu_so = ss

End Function
Function Doc_so(InputNum As Double) As String
Dim i As Integer
Dim Mem As String
If InputNum = 0 Then
StrOut = ""
Else
StrOut = Trim$(Str(InputNum))
While (Mid(StrOut, Len(StrOut), 1) = "." Or Mid(StrOut, Len(StrOut), 1) = "0") And InStr(StrOut, ".") > 0
StrOut = Mid(StrOut, 1, Len(StrOut) - 1)
Wend
If InStr(StrOut, ".") > 0 Then
Mem = Mid(StrOut, 1, InStr(StrOut, ".") - 1)
Else
Mem = StrOut
End If
While Len(Mem) Mod 3 <> 0
Mem = " " + Mem
Wend
Ex = ""
For i = 1 To Len(Mem) \ 3
Select Case i
Case 1
If Doc_3_chu_so(Mid(Mem, Len(Mem) - i * 3 + 1, 3)) <> " " Then
Ex = Doc_3_chu_so(Mid(Mem, Len(Mem) - i * 3 + 1, 3)) + Ex
End If
Case 2
If Doc_3_chu_so(Mid(Mem, Len(Mem) - i * 3 + 1, 3)) <> " " Then
Ex = Doc_3_chu_so(Mid(Mem, Len(Mem) - i * 3 + 1, 3)) + " nghìn " + Ex
End If
Case 3
If Doc_3_chu_so(Mid(Mem, Len(Mem) - i * 3 + 1, 3)) <> " " Then
Ex = Doc_3_chu_so(Mid(Mem, Len(Mem) - i * 3 + 1, 3)) + " trieäu " + Ex
End If
Case 4
Ex = Doc_3_chu_so(Mid(Mem, Len(Mem) - i * 3 + 1, 3)) + " tyû " + Ex
Case 5
Ex = Doc_3_chu_so(Mid(Mem, Len(Mem) - i * 3 + 1, 3)) + " nghìn tyû " + Ex
End Select
Next i
If InStr(StrOut, ".") > 0 Then
Mem = Mid(StrOut, InStr(StrOut, ".") + 1, 2)
While Len(Mem) < 3
Mem = " " + Mem
Wend
Mem = Doc_3_chu_so(Mem)
While Left(Mem, 1) = " "
Mem = Mid(Mem, 2, Len(Mem) - 1)
Wend
StrOut = Ex + " phaåy " + Mem
Else
StrOut = Ex
End If
End If
StrOut = Trim$(StrOut)
If Len(StrOut) > 1 Then StrOut = UCase$(Left$(StrOut, 1)) + Right$(StrOut, Len(StrOut) - 1)
If Trim$(StrOut) = "" Then StrOut = "Khoâng"
Doc_so = StrOut

End Function

-------------------------------

Cách dùng : Doc_so (123456789.12)
Tiếng Việt kết quả dùng font VNI, ai muốn font khác liên hệ với tôi nhé.

1 nhận xét:

Unknown nói...

Thuật toán chuyển từ số sang chữ, dùng trong môi trường Microsoft Office, Visual Basic, ASP, ...
Chào bạn. Bạn viết chương trình con này quá hay.