Hàm chuyển số thành chữ

Đã có rất nhiều hàm chuyển số thành chữ trên các diễn đàn, nhưng hôm nay, tôi xin giới thiệu với các bạn hàm chuyển số thành chữ hoàn chỉnh nhất của Paulsteigel trên diễn đàn Webketoan
Nội dung trích xuất từ tài liệu:
Hàm chuyển số thành chữ Hàm chuyển số thành chữ Đã có rất nhiều hàm chuyển số thành chữ trên các diễn đàn, nhưng hôm nay, tôi xin giới thiệu với các bạn hàm chuyển số thành chữ hoàn chỉnh nhất của Paulsteigel trên diễn đàn Webketoan Code: Option Explicit Function CountValue(ByVa l Target As Range, ByVal Criteria As Long, ByVal isGreater As Boolean) As Variant Dim i As Long, j As Long Dim k As Long With Target For i = 1 To .Rows.Count For j = 1 To .Columns.Count If Not IsEmpty(.Cells(i, j)) Then If isGreater Then If Val(.Cells(i, j)) >= Criteria Then k = k + 1 Else If Val(.Cells(i, j)) Public Function NumtoWordExl(ByVal Target As Range, Optional IsToUnicode As Boolean = False) As String Dim iStr As String, i As Long Dim retVal As String If isBigRange(Target) Then NumtoWordExl = GoTo tExitFunction End If ' this is a trick to keep excel doesnt set the value to somewhat like 1.22e12+19 iStr = Format(Target.Value, #000) retVal = NumtoWord(iStr) ' Now we have to convert the result to unicode if neccessary If retVal And IsToUnicode Then retVal = ToUnicode(retVal) NumtoWordExl = retVal tExitFunction: End Function Function NumtoWord(InTxt As String) As String ' Concert any length number to word ' The mentor is: break a number to 9 characters length and do the conversion ' for the rest .... increment the billion counter ' the main function for the conversion is at anywhere in the net and I took this one from anonimity ' My onwed function work similarly - but i failed in searching for it - it dumbed... ' so take this one in replacement Dim i As Integer, j As Integer Dim OutString As String Dim ProcArr() As String ReDim ProcArr(10) While Len(InTxt) > 9 ' break the input string to group of 9 digit ProcArr(i) = Right(InTxt, 9) InTxt = Left(InTxt, Len(InTxt) - 9) i=i+1 Wend ProcArr(i) = InTxt ReDim Preserve ProcArr(i) ' Now convert the group to value i = UBound(ProcArr) While i > 0 ' add with w as billion word... OutString = OutString & IIf(Val(ProcArr(i)) > 0, ReadBilGroup(ProcArr(i)) & String(i, w), ) i=i-1 Wend OutString = Replace(OutString, w, tû) & ReadBilGroup(ProcArr(0)) NumtoWord = Trim(OutString) End Function Private Function ReadBilGroup(s As String) As String Dim l As Integer, i As Integer, j As Integer Dim dk As Boolean Dim A(11) As Integer Dim C As String ' Variant array to quick convert the number to word Dim iArr As Variant iArr = Array(kh«ng, mét, hai, ba, bèn, n¨m, s¸u, b¶y, t¸m, chÝn) C = l = Len(s) ' break number to single string For i = 1 To l A(i) = CInt(Mid(s, i, 1)) Next i For i = 1 To l ' Select Case A(i) Case 1: If (i > 1 And (l - i + 1) Mod 3 = 1 And A(i - 1) > 1) Then C = C & mèt ElseIf ((l - i + 1) Mod 3 2 And A(i) = 1) Then C = C & mét End If Case 5: If (i > 0 And (l - i + 1) Mod 3 = 1 And A(i - 1) 0) Then C = C & l¨m Else C = C & n¨m End If Case 0: If (l - i + 1) Mod 3 = 0 And (A(i + 1) 0 Or A(i + 2) 0) Then C = C & kh«ng If (l - i + 1) Mod 3 = 2 And A(i + 1) 0 Then C = C & linh Case Else