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

Chia sẻ: Nguyen Quy | Ngày: | Loại File: PDF | Số trang:8

Thêm vào BST

Báo xấu

180
lượt xem 17
download

Download Vui lòng tải xuống để xem tài liệu đầy đủ

Đã 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

Chủ đề:

Bình luận(0) Đăng nhập để gửi bình luận!

Lưu

Nội dung Text: 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