Lớp học GPE tháng 9 - TPHCM: Name động và Biểu đồ (tối 11, 13 và 15/9) | PivotTable (tối 12, 14 và 16/9) |
Hàm thống kê, chuỗi và công thức mảng (tối 18, 20 và 22/9)

Đăng ký học VBA và ADO - 3 chủ nhật 10, 17 và 24/9 - TPHCM

Đăng ký học VBA Cơ bản 8 buổi tối thứ 3-5-7 từ 19/9 - 5/10/2017 - TPHCM

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

Thảo luận trong 'Lập Trình với Excel' bắt đầu bởi handung107, 13 Tháng sáu 2006.

  1. handung107

    handung107 Administrator Staff Member

    Đã 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
    Mã:
     
     
    Option Explicit
    '
    Function CountValue(ByVal 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)) <= Criteria Then k = k + 1
    End If
    End If
    Next
    Next
    End With
    CountValue = k + 1
    End Function
     
     
    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
    If i = l And A(i) = 4 Then
    C = C & " t&shy;"
    Else
    C = C & " " & iArr(A(i))
    End If
    End Select
     
    If ((l - i + 1) Mod 3 = 2 And A(i) <> 0 And A(i) <> 1) Then
    C = C & " m&shy;¬i"
    ElseIf ((l - i + 1) Mod 3 = 2 And A(i) <> 0) Then
    C = C & " m&shy;êi"
    End If
     
    If ((l - i + 1) Mod 3 = 0 And (A(i + 1) <> 0 Or A(i + 2) <> 0)) Then
    C = C & " tr¨m"
    ElseIf (l - i + 1) Mod 3 = 0 And A(i) <> 0 Then
    C = C & " tr¨m"
    End If
     
    If ((l - i + 1) = 4) Then C = C & " ngµn"
    If ((l - i + 1) = 7) Then C = C & " triÖu"
     
    If ((l - i + 1) Mod 3 = 0 And A(i) = 0 And A(i + 1) = 0 And A(i + 2) = 0) Then i = i + 2
     
    If ((l - i + 1) Mod 3 = 1) Then
    dk = True
    For j = i To l
    If A(j) <> 0 Then dk = False
    Next j
    End If
    If dk Then Exit For
    Next i
    ReadBilGroup = C
    End Function
     
     
    Private Function isBigRange(ByVal Target As Range) As Boolean
    On Error GoTo ErrHandler
    If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then isBigRange = True
    ErrHandler:
    End Function
    Function ToUnicode(txtString As String, Optional isReversed As Boolean = False) As String
    ' This function will do the conversion of text string into unicode
    Dim iStr As String, repTxt As String, mText As String
    Dim i As Long, j As Long
    Dim iUnicode As Variant ' array to keep unicode char set
    Dim iTCVN As Variant ' array to keep TCVN char set
    Dim iProcList() As String ' array to keep what to convert
     
    'parse the parameter into this local variable
    iStr = txtString
    mText = txtString
     
    iUnicode = Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, _
    7845, 7847, 7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 234, 7871, 7873, 7875, _
    7877, 7879, 237, 236, 7881, 297, 7883, 243, 242, 7887, 245, 7885, 244, 7889, 7891, _
    7893, 7895, 7897, 417, 7899, 7901, 7903, 7905, 7907, 250, 249, 7911, 361, 7909, _
    432, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, 7925, 273, 193, 192, 195, _
    258, 194, 212, 416, 431, 272)
     
    iTCVN = Array(184, 181, 182, 183, 185, 168, 190, 187, 188, 189, 198, 169, 202, 199, 200, _
    201, 203, 208, 204, 206, 207, 209, 170, 213, 210, 211, 212, 214, 221, 215, 216, 220, _
    222, 227, 223, 225, 226, 228, 171, 232, 229, 230, 231, 233, 172, 237, 234, 235, 236, _
    238, 243, 239, 241, 242, 244, 173, 248, 245, 246, 247, 249, 253, 250, 251, 252, 254, _
    174, 193, 192, 195, 161, 162, 164, 165, 166, 167)
     
    ' Reenlarge the array
    ReDim iProcList(1, 133)
    ' process the vowel only and covert to asc code
    For i = 1 To Len(mText)
    repTxt = Mid(mText, i, 1)
    If AscW(repTxt) > 122 Then
    iStr = Replace(iStr, repTxt, "[" & AscW(repTxt) & "]")
    mText = Replace(mText, repTxt, " ")
    ' write the processed list
    iProcList(1, j) = "[" & AscW(repTxt) & "]"
    If isReversed Then
    iProcList(0, j) = GetElementNo(AscW(repTxt), iUnicode)
    Else
    iProcList(0, j) = GetElementNo(AscW(repTxt), iTCVN)
    End If
    j = j + 1
    End If
    Next
    If j = 0 Then
    ToUnicode = txtString
    Exit Function
    End If
    ReDim Preserve iProcList(1, j - 1)
    ' now convert to unicode
    For i = 0 To UBound(iProcList, 2)
    If isReversed Then
    iStr = Replace(iStr, iProcList(1, i), ChrW(iTCVN(Val(iProcList(0, i)))))
    Else
    iStr = Replace(iStr, iProcList(1, i), ChrW(iUnicode(Val(iProcList(0, i)))))
    End If
    Next
    fExit:
    ToUnicode = iStr
    End Function
    
     
  2. trai_thanhnam

    trai_thanhnam Thành viên mới

    Hàm nay dài quá đợi em lam xong ham dịch số tiếng anh và tiếng việt để các bác sai thử nhé.
     
  3. Pansy_flower

    Pansy_flower ...nợ người, nợ đời...

    SG mong đc học hỏi file của bạn. Bạn xem thử Add-ins đọc số thành chữ của anh Maika tại đây xem nha.

    Sau khi dowload file về. Bạn giải nén. Copy file bạn vừa giải nén. Tiếp theo bạn vào tool====>add-ins======>browse======>paste file bạn vừa giải nén vào.

    Bạn xem thêm bài: Minh họa cách tạo, nạp và sử dụng Add-Ins trong MS Excel nha.
     
  4. quan_tn

    quan_tn Thành viên mới

    Tôi xin gửi các bạn hàm đổi số thành chữ của tôi, mong các bạn tham gia góp ý.
    Để sử dụng:
    1. Bạn Copy File UDF.XLA vào C:\Program Files\Microsoft Office\OFFICE11\Library
    2. Mở Excel chọn Tools -> Add-ins rồi check vào UDF (Lưu ý phải để Tools->Macro->Security->Low)
    Cách dùng: Tại ô cần đổi số thành chữ nhập =tien(địa chỉ ô hoặc số cần đổi) Enter.
    quan66nm@yahoo.com
     
  5. Chuotdong

    Chuotdong Thành viên thường trực

  6. Mr Okebab

    Mr Okebab Ngon Ngất Ngây

    Bạn xem qua nhé :


    PHP:
     Public Function USD(WhatNumber)
    ' Tien USD tieng Anh' 
     
    Dim ToReadNumStringGroupWord As String
    Dim I
    As ByteWXYAs Double
    Dim FristColum
    SecondColumReadMetho
    If WhatNumber 0 Then
    ToRead 
    "None"
    Else
    If 
    Abs(WhatNumber) >= 1E+15 Then
    ToRead 
    "Too long number ???"
    Else
    FristColum = Array("None""one""two""three""four""five""six""seven""eight""nine""ten"_
    "eleven""twelve""thirteen""fourteen""fifteen""sixteen""seventeen""eightteen""nineteen")
    SecondColum = Array("None""None""twenty""thirty""forty""fifty""sixty""seventy""eighty""ninety")
    ReadMetho = Array("None""trillion""billion""million""thousand""dollars""cents")
    If 
    WhatNumber 0 Then
    ToRead 
    "Minus" Space(1)
    Else
    ToRead Space(0)
    End If
    NumString Format(Abs(WhatNumber), "##############0.00")
    NumString Right(Space(15) & NumString18)
    For 
    1 To 6
    Group 
    Mid(NumString23)
    If 
    Group <> Space(3Then
    Select 
    Case Group
    Case "000"
    If And Abs(WhatNumber) > 1 Then
    Word 
    "dollars" Space(1)
    Else
    Word Space(0)
    End If
    Case 
    ".00"
    Word "only"
    Case Else
    Val(Left(Group1))
    Val(Mid(Group21))
    Val(Right(Group1))
    Val(Right(Group2))
    If 
    0 Then
    Word 
    Space(0)
    Else
    Word FristColum(X) & Space(1) & "hundred" Space(1)
    If 
    And 21 Then
    Word 
    Word "and" Space(1)
    End If
    End If
    If 
    And Abs(WhatNumber) > 1 Then
    Word 
    "and" Space(1) & Word
    End 
    If
    If 
    20 And 0 Then
    Word 
    Word FristColum(W) & Space(1)
    Else
    If 
    >= 20 Then
    Word 
    Word SecondColum(Y) & Space(1)
    If 
    0 Then
    Word 
    Word FristColum(Z) & Space(1)
    End If
    End If
    End If
    Word Word ReadMetho(I) & Space(1)
    End Select
    ToRead 
    ToRead Word
    End 
    If
    Next I
    End 
    If
    End If
    USD UCase(Left(ToRead1)) & Mid(ToRead2)
    End Function
    Public Function 
    VND_US(WhatNumber)
    ' Tien Viet tieng Anh
     
    Dim ToRead, NumString, Group, Word As String
    Dim I, J As Byte, W, X, Y, Z As Double
    Dim FristColum, SecondColum, ReadMetho
    If WhatNumber = 0 Then
    ToRead = "None"
    Else
    If Abs(WhatNumber) >= 1E+15 Then
    ToRead = "! Too long number ???"
    Else
    FristColum = Array("None", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", _
    "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eightteen", "nineteen")
    SecondColum = Array("None", "None", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety")
    ReadMetho = Array("None", "trillion", "billion", "million", "thousand", "Vietnamese dong", "xu")
    If WhatNumber < 0 Then
    ToRead = "Minus" & Space(1)
    Else
    ToRead = Space(0)
    End If
    NumString = Format(Abs(WhatNumber), "##############0.00")
    NumString = Right(Space(15) & NumString, 18)
    For I = 1 To 6
    Group = Mid(NumString, I * 3 - 2, 3)
    If Group <> Space(3) Then
    Select Case Group
    Case "000"
    If I = 5 And Abs(WhatNumber) > 1 Then
    Word = "Vietnamese dong" & Space(1)
    Else
    Word = Space(0)
    End If
    Case ".00"
    Word = "only"
    Case Else
    X = Val(Left(Group, 1))
    Y = Val(Mid(Group, 2, 1))
    Z = Val(Right(Group, 1))
    W = Val(Right(Group, 2))
    If X = 0 Then
    Word = Space(0)
    Else
    Word = FristColum(X) & Space(1) & "hundred" & Space(1)
    If W > 0 And W < 21 Then
    Word = Word & "and" & Space(1)
    End If
    End If
    If I = 6 And Abs(WhatNumber) > 1 Then
    Word = "and" & Space(1) & Word
    End If
    If W < 20 And W > 0 Then
    Word = Word & FristColum(W) & Space(1)
    Else
    If W >= 20 Then
    Word = Word & SecondColum(Y) & Space(1)
    If Z > 0 Then
    Word = Word & FristColum(Z) & Space(1)
    End If
    End If
    End If
    Word = Word & ReadMetho(I) & Space(1)
    End Select
    ToRead = ToRead & Word
    End If
    Next I
    End If
    End If
    VND_US = UCase(Left(ToRead, 1)) & Mid(ToRead, 2)
    End Function

    Thân!
     
    Chỉnh sửa lần cuối bởi điều hành viên: 3 Tháng sáu 2008
  7. Lephuongthuy411

    Lephuongthuy411 Thành viên mới

    Em đã làm đúng các bước hướng dẫn rồi mà sao em ko thể lôi hàm đó ra dùng được. Các anh chị giúp em bé với...........!$@!!
     
  8. anhphuong

    anhphuong Thân Thương

    Các bước thực hiện

    B1: Mở một Workbook mới, nhấn Alt+F11 để vào VBA
    B2: Copy hàm vừa mới dow về vào trang VBA đó rồi thoát khỏi VBA
    B3: Save lại với đuôi là .xla(File/Save As chọn trong khung Save as type là Microsoft Excel Add-In) . Nhớ đường dẫn tới file này và đặt tên cho nó
    Thường thì khi save như trên nó sẽ tự động save vào thư mục mặc định Add-In (Documents and Setings/Ten chủ máy/Application Data/Microsoft/AddIns)
    B4: Vào Tools/Add In ======>Bowser =====>chọn đường dẫn tới file vừa save=====> OK
    Thế là dùng thoải mái
    Thân
     
  9. man

    man Thành viên mới

    tui cung xin đóng góp 1 hàm chuyển từ số sang chữ
     

    Các file đính kèm:

    • Book1.xls
      Kích thước:
      34.5 KB
      Đọc:
      6,008
    Lần chỉnh sửa cuối: 9 Tháng sáu 2007
  10. chibi

    chibi Thành viên danh dự

    To man
    Dùng cho font UNICODE thì làm sao đây?

    To handung
    Bị báo lỗi tại GetElementNo là sao vậy?
     
    Lần chỉnh sửa cuối: 10 Tháng sáu 2007
  11. vungoc

    vungoc Thành viên tiêu biểu

    Đây là hàm của bác phamduylong - rất chuẩn và đa dạng (VNI, UNI, ABC, ...)

    Mã:
     
    Function DocSoVni(conso) As String
    s09 = Array("", " moät", " hai", " ba", " boán", " naêm", " saùu", " baûy", " taùm", " chín")
    lop3 = Array("", " trieäu", " nghìn", " tyû")
    If Trim(conso) = "" Then
    DocSoVni = ""
    ElseIf IsNumeric(conso) = True Then
    If conso < 0 Then dau = "aâm " Else dau = ""
    conso = Application.WorksheetFunction.Round(Abs(conso), 0)
    conso = " " & conso
    conso = Replace(conso, ",", "", 1)
    vt = InStr(1, conso, "E")
    If vt > 0 Then
    sonhan = Val(Mid(conso, vt + 1))
    conso = Trim(Mid(conso, 2, vt - 2))
    conso = conso & String(sonhan - Len(conso) + 1, "0")
    End If
    conso = Trim(conso)
    sochuso = Len(conso) Mod 9
    If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
    docso = ""
    I = 1
    lop = 1
    Do
    n1 = Mid(conso, I, 1)
    n2 = Mid(conso, I + 1, 1)
    n3 = Mid(conso, I + 2, 1)
    baso = Mid(conso, I, 3)
    I = I + 3
    If n1 & n2 & n3 = "000" Then
    If docso <> "" And lop = 3 And Len(conso) - I > 2 Then s123 = " tyû" Else s123 = ""
    Else
    If n1 = 0 Then
    If docso = "" Then s1 = "" Else s1 = " khoâng traêm"
    Else
    s1 = s09(n1) & " traêm"
    End If
    If n2 = 0 Then
    If s1 = "" Or n3 = 0 Then
    s2 = ""
    Else
    s2 = " linh"
    End If
    Else
    If n2 = 1 Then s2 = " möôøi" Else s2 = s09(n2) & " möôi"
    End If
    If n3 = 1 Then
    If n2 = 1 Or n2 = 0 Then s3 = " moät" Else s3 = " moát"
    ElseIf n3 = 5 And n2 <> 0 Then
    s3 = " laêm"
    Else
    s3 = s09(n3)
    End If
    If I > Len(conso) Then
    s123 = s1 & s2 & s3
    Else
    s123 = s1 & s2 & s3 & lop3(lop)
    End If
    End If
    lop = lop + 1
    If lop > 3 Then lop = 1
    docso = docso & s123
    If I > Len(conso) Then Exit Do
    Loop
    If docso = "" Then DocSoVni = "khoâng" Else DocSoVni = dau & Trim(docso)
    Else
    DocSoVni = conso
    End If
    End Function
     
    '==================================
    Function DocSoAbc(conso) As String
    s09 = Array("", " mét", " hai", " ba", " bèn", " n¨m", " s¸u", " b¶y", " t¸m", " chÝn")
    lop3 = Array("", " triÖu", " ngh×n", " tû", " triÖu", " ngh×n", "")
    If Trim(conso) = "" Then
    DocSoAbc = ""
    ElseIf IsNumeric(conso) = True Then
    If conso < 0 Then dau = "©m " Else dau = ""
    conso = Application.WorksheetFunction.Round(Abs(conso), 0)
    conso = " " & conso
    conso = Replace(conso, ",", "", 1)
    vt = InStr(1, conso, "E")
    If vt > 0 Then
    sonhan = Val(Mid(conso, vt + 1))
    conso = Trim(Mid(conso, 2, vt - 2))
    conso = conso & String(sonhan - Len(conso) + 1, "0")
    End If
    conso = Trim(conso)
    sochuso = Len(conso) Mod 9
    If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
    docso = ""
    I = 1
    lop = 1
    Do
    n1 = Mid(conso, I, 1)
    n2 = Mid(conso, I + 1, 1)
    n3 = Mid(conso, I + 2, 1)
    baso = Mid(conso, I, 3)
    I = I + 3
    If n1 & n2 & n3 = "000" Then
    If docso <> "" And lop = 3 And Len(conso) - I > 2 Then s123 = " tû" Else s123 = ""
    Else
    If n1 = 0 Then
    If docso = "" Then s1 = "" Else s1 = " kh«ng tr¨m"
    Else
    s1 = s09(n1) & " tr¨m"
    End If
    If n2 = 0 Then
    If s1 = "" Or n3 = 0 Then
    s2 = ""
    Else
    s2 = " linh"
    End If
    Else
    If n2 = 1 Then s2 = " m&shy;êi" Else s2 = s09(n2) & " m&shy;¬i"
    End If
    If n3 = 1 Then
    If n2 = 1 Or n2 = 0 Then s3 = " mét" Else s3 = " mèt"
    ElseIf n3 = 5 And n2 <> 0 Then
    s3 = " l¨m"
    Else
    s3 = s09(n3)
    End If
    If I > Len(conso) Then
    s123 = s1 & s2 & s3
    Else
    s123 = s1 & s2 & s3 & lop3(lop)
    End If
    End If
    lop = lop + 1
    If lop > 3 Then lop = 1
    docso = docso & s123
    If I > Len(conso) Then Exit Do
    Loop
    If docso = "" Then DocSoAbc = "kh«ng" Else DocSoAbc = dau & Trim(docso)
    Else
    DocSoAbc = conso
    End If
    End Function
    '===============================
    Function DocSoUni(conso) As String
    s09 = Array("", " m" & ChrW(7897) & "t", " hai", " ba", " b" & ChrW(7889) & "n", " n" & _
    ChrW(259) & "m", " s" & ChrW(225) & "u", " b" & ChrW(7843) & "y", " t" & ChrW(225) & "m", " ch" & ChrW(237) & "n")
    lop3 = Array("", " tri" & ChrW(7879) & "u", " ngh" & ChrW(236) & "n", " t" & ChrW(7927))
    'Stop
    If Trim(conso) = "" Then
    DocSoUni = ""
    ElseIf IsNumeric(conso) = True Then
    If conso < 0 Then dau = ChrW(226) & "m " Else dau = ""
    conso = Application.WorksheetFunction.Round(Abs(conso), 0)
    conso = " " & conso
    conso = Replace(conso, ",", "", 1)
    vt = InStr(1, conso, "E")
    If vt > 0 Then
    sonhan = Val(Mid(conso, vt + 1))
    conso = Trim(Mid(conso, 2, vt - 2))
    conso = conso & String(sonhan - Len(conso) + 1, "0")
    End If
    conso = Trim(conso)
    sochuso = Len(conso) Mod 9
    If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
    docso = ""
    I = 1
    lop = 1
    Do
    n1 = Mid(conso, I, 1)
    n2 = Mid(conso, I + 1, 1)
    n3 = Mid(conso, I + 2, 1)
    baso = Mid(conso, I, 3)
    I = I + 3
    If n1 & n2 & n3 = "000" Then
    If docso <> "" And lop = 3 And Len(conso) - I > 2 Then s123 = " t" & ChrW(7927) Else s123 = ""
    Else
    If n1 = 0 Then
    If docso = "" Then s1 = "" Else s1 = " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
    Else
    s1 = s09(n1) & " tr" & ChrW(259) & "m"
    End If
    If n2 = 0 Then
    If s1 = "" Or n3 = 0 Then
    s2 = ""
    Else
    s2 = " linh"
    End If
    Else
    If n2 = 1 Then s2 = " m" & ChrW(432) & ChrW(7901) & "i" Else s2 = s09(n2) & " m" & ChrW(432) & ChrW(417) & "i"
    End If
    If n3 = 1 Then
    If n2 = 1 Or n2 = 0 Then s3 = " m" & ChrW(7897) & "t" Else s3 = " m" & ChrW(7889) & "t"
    ElseIf n3 = 5 And n2 <> 0 Then
    s3 = " l" & ChrW(259) & "m"
    Else
    s3 = s09(n3)
    End If
    If I > Len(conso) Then
    s123 = s1 & s2 & s3
    Else
    s123 = s1 & s2 & s3 & lop3(lop)
    End If
    End If
    lop = lop + 1
    If lop > 3 Then lop = 1
    docso = docso & s123
    If I > Len(conso) Then Exit Do
    Loop
    If docso = "" Then DocSoUni = "kh" & ChrW(244) & "ng" Else DocSoUni = dau & Trim(docso)
    Else
    DocSoUni = conso
    End If
    End Function
    
     
    Chỉnh sửa lần cuối bởi điều hành viên: 13 Tháng sáu 2007
  12. man

    man Thành viên mới

    rất tiếc!Lỗi đó là đúng rùi!bài này mình chỉ viết với font VNtime!Kết quả hiện ra đã được mặc định là VNtime!Lỗi này mình sẽ sửa!Tại đọc ko kỹ nên mới post bài ngay!Thành thật xin lỗi!
     
  13. trandn

    trandn Thành viên mới

    Vấn đề khi đọc số có phần sau số thập phân thì đọc ra sao nhỉ?
    Ví dụ: quản lý tiền USD đowng nhiên phải quản lý đến Cent: 123,23 USD thì có thể đọc ra được không?
     
  14. Mr Okebab

    Mr Okebab Ngon Ngất Ngây

    Bạn hãy đọc lại bài số 8 (13/3/07) về hàm USD, nó sẽ chuyển đổi ngay cho bạn

    One hundred twenty three dollars and twenty three cents


    Thân!
     
  15. Paiper

    Paiper Thành viên mới

    Chào Secret_grasses nhưng File của anh Maika chỉ đọc thành tiền chứ ko đọc số thành bình thường phải ko bạn?
    Mình chưa học lập trình Excell nên ko rõ mình là IT nhân viên trong công ty hỏi mình. Nên mình lên GPEX search. Cám ơn bạn giúp đỡ |||||
    Bạn có File nào đọc số thành chữ hoàn chỉnh và hay thì up lên giùm mình với, thanhks a lot! (Không đọc thành tiền) hii
     
  16. tedaynui

    tedaynui (*_*)

    Cái này trên GPE nhiều lắm. Bạn có thể tìm hàm chuyển đổi của thầy Phamduylong rất chuẩn hoặc của TuanVNUNI rất "tốc độ"
    http://www.giaiphapexcel.com/forum/showthread.php?t=1047

    TDN
     
  17. blueseaftc

    blueseaftc Thành viên mới

    ba con oi giúp minh với, minh làm phiếu chi ở công ty, mình muốn dùng hàm đổi tiền từ số sang chữ, mình đã làm như hướng dẫn nhưng không được.Mình copy cái hàm đó và mở VBA, nhưng mình không thể paste vào
    VBA.có thể chỉ dẫn cụ thể cho mình được không? cảm ơn trước nhé
     
  18. kiendt1973

    kiendt1973 Thành viên mới

    làm thế nào để thêm đc: ( Bằng chữ ..... đ) vào hàm của bác Phạm duy Long bây giờ nhỉ?
     
  19. phamduylong

    phamduylong Thành viên danh dự

    Em áp dụng toán tử nối chuỗi kết hợp với hàm đọc số.
    Ví dụ B3 có số 100. Muốn kết quả là "Bằng chữ: một trăm đồng." (dùng hàm DocsoUni chuyển số thành chữ)
    Công thức ="Bằng chữ: " & DocUni(B3) & " đồng."
     
  20. PhanTuHuong

    PhanTuHuong Excel & AutoCad & VBA

    Hàm của bác Long là ngắn nhất, phù hợp với công việc đổi tiền. Còn 1 số hàm khác hơi dài nhưng lại phù hợp với việc đổi số (thêm phần thập phân).
     

Chia sẻ trang này