Tạo hàm đọc số thành chữ trong Excel
Private Function Doc(so As String) As String
Dim j As Integer, i As Integer
Dim s1 As String, s2 As String
s1 = "10" + so
j = Len(so)
s2 = ""
For i = 3 To j + 2
Select Case Mid(s1, i, 1)
Case "0":
Select Case (j - i + 2) Mod 3
Case 0: If j = 1 Then s2 = " kh" + ChrW(244) + "ng"
Case 1:
If Mid(s1, i + 1, 1) <> "0" Then s2 = s2 + " l" + ChrW(7867)
Case 2:
If Mid(s1, i + 1, 2) <> "00" Then s2 = s2 + " kh" + ChrW(244) + "ng"
End Select
Case "1":
Select Case (j - i + 2) Mod 3
Case 0:
c = Mid(s1, i - 1, 1)
If c <> "0" And c <> "1" Then
s2 = s2 + " m" + ChrW(7889) + "t"
Else: s2 = s2 + " m" + ChrW(7897) + "t"
End If
Case 1: s2 = s2 + " m" + ChrW(432) + ChrW(7901) + "i"
Case 2: s2 = s2 + " m" + ChrW(7897) + "t"
End Select
Case "2": s2 = s2 + " hai"
Case "3": s2 = s2 + " ba"
Case "4": s2 = s2 + " b" + ChrW(7889) + "n"
Case "5":
If ((j - i + 2) Mod 3 = 0 And Mid(s1, i - 1, 1) <> "0") Then
s2 = s2 + " l" + ChrW(259) + "m"
Else: s2 = s2 + " n" + ChrW(259) + "m"
End If
Case "6": s2 = s2 + " s" + ChrW(225) + "u"
Case "7": s2 = s2 + " b" + ChrW(7843) + "y"
Case "8": s2 = s2 + " t" + ChrW(225) + "m"
Case "9": s2 = s2 + " ch" + ChrW(237) + "n"
End Select
Select Case (j - i + 2)
Case 1, 4, 7, 10, 13:
c = Mid(s1, i, 1)
If c <> "1" And c <> "0" Then s2 = s2 + " m" + ChrW(432) + ChrW(417) + "i"
Case 2, 5, 8, 11, 14:
If Mid(s1, i, 1) <> "0" Or Mid(s1, i + 1, 2) <> "00" Then s2 = s2 + " tr" + ChrW(259) + "m"
Case 3, 12: If Mid(s1, i - 2, 3) <> "000" Then s2 = s2 + " ng" + ChrW(224) + "n"
Case 6: If Mid(s1, i - 2, 2) <> "00" Then s2 = s2 + " tri" + ChrW(7879) + "u"
Case 9: s2 = s2 + " t" + ChrW(7881)
End Select
Next
Doc = Trim(s2)
End Function
Private Function DocRoi(so As String) As String
Dim i As Integer
Dim c As String * 1
Dim s As String
s = ""
For i = 1 To Len(so)
c = Mid(so, i, 1)
Select Case c
Case "0": s = s + "kh" + ChrW(244) + "ng "
Case "1": s = s + "m" + ChrW(7897) + "t "
Case "2": s = s + "hai "
Case "3": s = s + "ba "
Case "4": s = s + "b" + ChrW(7889) + "n "
Case "5": s = s + "n" + ChrW(259) + "m "
Case "6": s = s + "s" + ChrW(225) + "u "
Case "7": s = s + "b" + ChrW(7843) + "y "
Case "8": s = s + "t" + ChrW(225) + "m "
Case "9": s = s + "ch" + ChrW(237) + "n "
Case ".", ",": s = s + "ph" + ChrW(7849) + "y "
End Select
DocRoi = Trim(s)
Next
End Function
Public Function SoTien(so As String, Optional donvi As String = 0) As String
Select Case donvi
Case 0: donvi = ""
Case 1: donvi = " " + ChrW(273) + ChrW(7891) + "ng"
Case 2: donvi = " " + ChrW(273) + ChrW(7891) + "ng ch" + ChrW(7861) + "n"
Case 3: donvi = " VND"
Case 4: donvi = " USD"
Case 5: donvi = " GBP"
End Select
so = Trim(Str(Round(Val(so), 0)))
SoTien = Doc(so) + " " + Trim(donvi)
SoTien = UCase(Mid(SoTien, 1, 1)) + Mid(SoTien, 2, Len(SoTien) - 1)
End Function
Private Function XuLy(so As String) As String
Dim j As Byte, i As Byte
Dim c As String * 1
Dim d As Boolean
Dim s1 As String
d = False
For j = 1 To Len(so)
If Mid(so, j, 1) < "0" Or Mid(so, j, 1) > "9" Then
d = True
c = Mid(so, j, 1)
i = j
End If
Next
s1 = ""
For j = 1 To Len(so)
If Mid(so, j, 1) >= "0" And Mid(so, j, 1) <= "9" Then s1 = s1 + Mid(so, j, 1)
If j = i Then s1 = s1 + ","
Next
XuLy = s1
End Function
Public Function DocSo(so As String, Optional k As Byte = 0) As String
Dim s1 As String, s2 As String
Dim i As Integer
so = XuLy(so)
i = 1
Do
s1 = s1 + Mid(so, i, 1)
i = i + 1
Loop Until i = Len(so) + 1 Or Mid(so, i, 1) < "0" Or Mid(so, i, 1) > "9"
For j = i + 1 To Len(so)
If Mid(so, j, 1) >= "0" And Mid(so, j, 1) <= "9" Then s2 = s2 + Mid(so, j, 1)
Next j
If s1 = "" Then Exit Function
If k = 0 Then
DocSo = Doc(s1)
Else: DocSo = DocRoi(s1)
End If
If s2 <> "" Then
If k = 0 Then
DocSo = DocSo + " ph" + ChrW(7849) + "y " + Doc(s2)
Else: DocSo = DocSo + " ph" + ChrW(7849) + "y " + DocRoi(s2)
End If
End If
If Len(DocSo) > 1 Then
DocSo = UCase(Mid(DocSo, 1, 1)) + Mid(DocSo, 2, Len(DocSo) - 1)
End If
End Function
