Trang 1/12 1 2 3 4 5 11 ... cuốicuối
Hiển thị kết quả tìm kiếm từ 1 đến 10 trên tổng số: 116
  1. #1
    Tham gia ngày
    05 2006
    Nơi Cư Ngụ
    TP HCM
    Bài gởi
    1,466
    Cảm ơn
    1,202
    Được cảm ơn 16,201 lần trong 1,302 bài viết

    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(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­"
    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­¬i"
    ElseIf ((l - i + 1) Mod 3 = 2 And A(i) <> 0) Then
    C = C & " m­ê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. #2
    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. Có 11 thành viên cảm ơn trai_thanhnam về bài viết này:


  4. #3
    Tham gia ngày
    06 2006
    Bài gởi
    1,611
    Cảm ơn
    5,483
    Được cảm ơn 13,796 lần trong 1,705 bài viết
    Trích Nguyên văn bởi trai_thanhnam
    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é.
    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.

    Trích Nguyên văn bởi _RU_kiss
    Toi khong biet de cai add-in nhu the nao. Phai save link do vao dau. Anh chi nao biet chi gium.
    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.
    "A successful relationship requires falling in love many times, always with the same person!"

  5. Có 9 thành viên cảm ơn Pansy_flower về bài viết này:


  6. #4
    Tham gia ngày
    11 2006
    Bài gởi
    7
    Cảm ơn
    22
    Được cảm ơn 17 lần trong 2 bài viết
    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

  7. Có 15 thành viên cảm ơn quan_tn về bài viết này:


  8. #5
    Tham gia ngày
    11 2006
    Bài gởi
    247
    Cảm ơn
    173
    Được cảm ơn 56 lần trong 25 bài viết

    Red face

    Đây cũng là hàm chuyển chữ sang số:
    http://www.4shared.com/file/6685708/...44/So2Chu.html

  9. Thành viên sau cảm ơn Chuotdong về bài viết này:


  10. #6
    Tham gia ngày
    08 2006
    Bài gởi
    3,267
    Cảm ơn
    1,733
    Được cảm ơn 3,738 lần trong 1,765 bài viết
    Trích Nguyên văn bởi Bong05
    Co ban nao co dich so = chu USD ko? huong dan cho minh su dung voi. Mail cua minh: maiminhtien@yahoo.com
    Bạn xem qua nhé :


    PHP Code:
     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!
    thay đổi nội dung bởi: SA_DQ, 03-06-08 lúc 09:22 AM

  11. Có 9 thành viên cảm ơn Mr Okebab về bài viết này:


  12. #7
    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...........

  13. #8
    Tham gia ngày
    03 2007
    Bài gởi
    505
    Cảm ơn
    313
    Được cảm ơn 2,460 lần trong 440 bài viết

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

    Trích Nguyên văn bởi Lephuongthuy411
    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...........
    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

  14. Có 11 thành viên cảm ơn anhphuong về bài viết này:


  15. #9
    Tham gia ngày
    05 2007
    Bài gởi
    8
    Cảm ơn
    0
    Được cảm ơn 19 lần trong 2 bài viết
    tui cung xin đóng góp 1 hàm chuyển từ số sang chữ
    Tập tin đính kèm Tập tin đính kèm
    thay đổi nội dung bởi: man, 09-06-07 lúc 04:49 PM


  16. #10
    Tham gia ngày
    01 2007
    Bài gởi
    1,121
    Cảm ơn
    160
    Được cảm ơn 619 lần trong 369 bài viết
    To man
    Trích Nguyên văn bởi man
    tui cung xin đóng góp 1 hàm chuyển từ số sang chữ
    Dùng cho font UNICODE thì làm sao đây?

    To handung
    If isReversed Then
    iProcList(0, j) = GetElementNo(AscW(repTxt), iUnicode)
    Else
    iProcList(0, j) = GetElementNo(AscW(repTxt), iTCVN)
    End If
    Bị báo lỗi tại GetElementNo là sao vậy?
    thay đổi nội dung bởi: chibi, 10-06-07 lúc 12:11 AM

Trang 1/12 1 2 3 4 5 11 ... cuốicuối

Thông tin về chủ đề này

Users Browsing this Thread

Hiện có 2 người đang xem đề tài này. (0 thành viên và 2 khách)

Đề tài tương tự

  1. Tạo nút liên kết di chuyển theo sự di chuyển của trang trong Excell
    Viết bởi chuot0106 trong chuyên mục Lập Trình với Excel
    Trả lời: 5
    Bài mới gởi: 24-02-14, 04:09 PM
  2. Cần tuyển Trưởng phòng Kinh doanh, Chuyên viên Kế hoạch Đầu tư, Chuyên viên Thanh chế
    Viết bởi suribeo trong chuyên mục Người tìm việc, việc tìm người
    Trả lời: 0
    Bài mới gởi: 26-07-12, 09:26 AM
  3. Chuyển mã trong excel (tự nhận biết và chuyển về cùng bảng mã)
    Viết bởi taodayne trong chuyên mục Các Add-ins cho excel
    Trả lời: 6
    Bài mới gởi: 07-11-11, 08:05 PM
  4. Lỗi trang bảng tính không di chuyển khi kéo thanh scroll bar hoặc di chuyển bằng phím
    Viết bởi Tường_Vi trong chuyên mục Hỏi đáp những vấn đề khác
    Trả lời: 15
    Bài mới gởi: 22-07-10, 02:08 PM

Bookmarks

Bookmarks

Quyền Sử Dụng Ở Diễn Ðàn

  • Bạn không thể đăng đề tài mới
  • Bạn không thể đăng trả lời
  • Bạn không thể đăng file đính kèm.
  • Bạn không thể sửa bài viết.
  •  

Mudim v0.8 Tắt VNI Telex Viqr Tổng hợp
Chính tả Bỏ dấu kiểu mới  [Bật/Tắt (F9)]