Rất rất cần hàm dịch số ra chữ hoàn chỉnh

Thảo luận trong 'Ứng dụng Excel' bắt đầu bởi tungbv, 11 Tháng tám 2006.

6,678 lượt xem

  1. tungbv

    tungbv Thành viên sơ cấp

    Bài viết:
    2
    Đã được thích:
    0
    Nơi ở:
    Hoa Binh
    Mình đã dùng 1 số phần hướng dẫn chuyển số ra chữ như trong diễn đàn và đã làm được. Nhưng hiện đang gặp phải 1 vấn đề các nơi giao dịch chuyển tiền không chấp nhận cách viết bằng chữ đó:
    Nếu số tiền là: 123450 thì dịch ra là: Một trăm hai mươi ba ngàn bốn trăm năm mươi đồng chẵn. OK
    Nhưng khi số tiền là: 120004 thì chỉ dịch là: Một trăm hai mươi ngàn bốn đồng. Như thế người ta không chấp nhận. Dịch đúng phải là: Một trăm hai mươi ngàn không trăm linh bốn đồng
    Hoặc 120040 phải dịch là Một trăm hai mươi ngàn không trăm bốn mươi đồng chẵn chứ không được dịch Một trăm hai mươi ngàn bốn mươi đồng chẵn
    Vì tôi chuyển qua word nên cần phải dịch ra o dạng font unicode
    Có ai giúp mình chuyển ra chữ đầy đủ với. Cảm ơn các bạn
    Emai ketoanbv@yahoo.com
     
    Last edited: 11 Tháng tám 2006
    #1
  2. Longlv

    Longlv Thành viên sơ cấp

    Bài viết:
    44
    Đã được thích:
    1
    Nơi ở:
    Hanoi
    Bạn thử hàm sau xem :

    Function WriteVN(num As Currency) As String
    Dim deci(), ll, w, w1 As String
    Dim x, y, z, t, j, k As Long
    Dim a(), q, donvi(), chuc(), tram(), xu, hao As Integer

    y = Abs(num)
    x = Fix(y)
    q = Fix((y - x) * 100)
    z = Len(x)
    xu = q Mod 10
    hao = q \ 10 Mod 10
    If q = 0 Then
    w1 = w1
    Else
    End If
    If z <> 3 * Int(z / 3) Then
    t = Int(z / 3) + 1
    Else
    t = Int(z / 3)
    End If
    ReDim a(1 To t)
    If z = 1 Then
    a(1) = Val(Mid(x, 1, 1))
    End If
    If z = 2 Then
    a(1) = Val(Mid(x, 1, 2))
    End If
    If z = 3 * Int(z / 3) Then
    For j = 1 To t
    a(j) = Val(Mid(x, z + 1 - j * 3, 3))
    Next j
    End If
    If z = 3 * Int(z / 3) + 1 And t > 1 Then
    a(t) = Val(Mid(x, 1, 1))
    For j = 2 To t
    a(j - 1) = Val(Mid(x, z + 4 - j * 3, 3))
    Next j
    End If
    If z = 3 * Int(z / 3) + 2 And t > 1 Then
    a(t) = Val(Mid(x, 1, 2))
    For j = 2 To t
    a(j - 1) = Val(Mid(x, z + 4 - j * 3, 3))
    Next j
    End If
    ReDim deci(1 To 5)
    deci(1) = "": deci(2) = " ngh×n"
    deci(3) = " triÖu": deci(4) = " tû"

    If t = 5 Then
    If a(t - 1) = 0 Then
    deci(5) = " ngh×n tû"
    Else
    deci(5) = " ngh×n"
    End If
    End If
    ReDim donvi(1 To t)
    ReDim chuc(1 To t)
    ReDim tram(1 To t)
    For k = 1 To t
    donvi(k) = a(k) Mod 10
    chuc(k) = a(k) \ 10 Mod 10
    tram(k) = a(k) \ 100
    If a(k) <> 0 Then
    w = deci(k) + w
    Select Case donvi(k)
    Case 1
    If chuc(k) > 1 Then
    w = " mèt" + w
    Else
    w = " mét" + w
    End If
    Case 2: w = " hai" + w
    Case 3: w = " ba" + w
    Case 4
    If chuc(k) = 1 Or (chuc(k) = 0 And tram(k) = 0) Then
    w = " bèn" + w
    Else
    w = " t&shy;" + w
    End If
    Case 5
    If chuc(k) = 0 Then
    w = " n¨m" + w
    Else
    w = " l¨m" + w
    End If
    Case 6: w = " s¸u" + w
    Case 7: w = " b¶y" + w
    Case 8: w = " t¸m" + w
    Case 9: w = " chÝn" + w
    End Select
    Select Case chuc(k)
    Case 1: w = " m&shy;êi" + w
    Case 2: w = " hai m&shy;¬i" + w
    Case 3: w = " ba m&shy;¬i" + w
    Case 4: w = " bèn m&shy;¬i" + w
    Case 5: w = " n¨m m&shy;¬i" + w
    Case 6: w = " s¸u m&shy;¬i" + w
    Case 7: w = " b¶y m&shy;¬i" + w
    Case 8: w = " t¸m m&shy;¬i" + w
    Case 9: w = " chÝn m&shy;¬i " + w
    Case 0
    If tram(k) <> 0 And donvi(k) <> 0 Then
    w = " linh" + w
    End If
    End Select
    Select Case tram(k)
    Case 1: w = " mét tr¨m" + w
    Case 2: w = " hai tr¨m" + w
    Case 3: w = " ba tr¨m" + w
    Case 4: w = " bèn tr¨m" + w
    Case 5: w = " n¨m tr¨m" + w
    Case 6: w = " s¸u tr¨m" + w
    Case 7: w = " b¶y tr¨m" + w
    Case 8: w = " t¸m tr¨m" + w
    Case 9: w = " chÝn tr¨m" + w
    Case 0
    If t > k And chuc(k) = 0 Then
    w = " kh«ng tr¨m linh" + w
    End If

    If t > k And chuc(k) <> 0 Then
    w = " kh«ng tr¨m" + w
    End If

    End Select
    Else
    w = w
    End If
    Next k
    ll = LTrim(w)
    If num < 0 Then
    WriteVN = " ¢m " & ll & " ®ång" & w1 & "."
    WriteVN = Replace(WriteVN, " ", " ")
    WriteVN = Replace(WriteVN, " ", " ")
    Else
    WriteVN = "" & UCase(Left(ll, 1)) & Mid(ll, 2, Len(ll) - 1) & " ®ång ch½n" & w1 & "."
    WriteVN = Replace(WriteVN, " ", " ")
    WriteVN = Replace(WriteVN, " ", " ")
    End If

    End Function
     
    #2
  3. tungbv

    tungbv Thành viên sơ cấp

    Bài viết:
    2
    Đã được thích:
    0
    Nơi ở:
    Hoa Binh
    Trả lời

    Tôi đã chuyển được sang fonr unicode roiif, tuy nhien còn chữ "tỷ" tôi không chuyển được mong các bạn sửa lại mã chữ "tỷ" bằng unicode cho tôi

    Function Tung(num As Currency) As String
    Dim deci(), ll, w, w1 As String
    Dim x, y, z, t, J, k As Long
    Dim a(), q, donvi(), chuc(), tram(), xu, hao As Integer

    y = Abs(num)
    x = Fix(y)
    q = Fix((y - x) * 100)
    z = Len(x)
    xu = q Mod 10
    hao = q \ 10 Mod 10
    If q = 0 Then
    w1 = w1
    Else
    End If
    If z <> 3 * Int(z / 3) Then
    t = Int(z / 3) + 1
    Else
    t = Int(z / 3)
    End If
    ReDim a(1 To t)
    If z = 1 Then
    a(1) = Val(Mid(x, 1, 1))
    End If
    If z = 2 Then
    a(1) = Val(Mid(x, 1, 2))
    End If
    If z = 3 * Int(z / 3) Then
    For J = 1 To t
    a(J) = Val(Mid(x, z + 1 - J * 3, 3))
    Next J
    End If
    If z = 3 * Int(z / 3) + 1 And t > 1 Then
    a(t) = Val(Mid(x, 1, 1))
    For J = 2 To t
    a(J - 1) = Val(Mid(x, z + 4 - J * 3, 3))
    Next J
    End If
    If z = 3 * Int(z / 3) + 2 And t > 1 Then
    a(t) = Val(Mid(x, 1, 2))
    For J = 2 To t
    a(J - 1) = Val(Mid(x, z + 4 - J * 3, 3))
    Next J
    End If
    ReDim deci(1 To 5)
    deci(1) = "": deci(2) = " ng" & ChrW$(224) & "n"
    deci(3) = " tri" & ChrW$(7879) & "u": deci(4) = " t" & ChrW$(272)

    If t = 5 Then
    If a(t - 1) = 0 Then
    deci(5) = " ngh×n tû"
    Else
    deci(5) = " ng" & ChrW$(224) & "n"
    End If
    End If
    ReDim donvi(1 To t)
    ReDim chuc(1 To t)
    ReDim tram(1 To t)
    For k = 1 To t
    donvi(k) = a(k) Mod 10
    chuc(k) = a(k) \ 10 Mod 10
    tram(k) = a(k) \ 100
    If a(k) <> 0 Then
    w = deci(k) + w
    Select Case donvi(k)
    Case 1
    If chuc(k) > 1 Then
    w = " m" & ChrW$(7889) & "t" + w
    Else
    w = " m" & ChrW$(7897) & "t" + w
    End If
    Case 2: w = " hai" + w
    Case 3: w = " ba" + w
    Case 4
    If chuc(k) = 1 Or (chuc(k) = 0 And tram(k) = 0) Then
    w = " b" & ChrW$(7889) & "n " + w
    Else
    w = " t&shy;" + w
    End If
    Case 5
    If chuc(k) = 0 Then
    w = " n" & ChrW$(259) & "m " + w
    Else
    w = " l" & ChrW$(259) & "m" + w
    End If
    Case 6: w = " s" & ChrW$(225) & "u" + w
    Case 7: w = " b" & ChrW$(7849) & "y" + w
    Case 8: w = " t" & ChrW$(225) & "m " + w
    Case 9: w = " ch" & ChrW$(237) & "n" + w
    End Select
    Select Case chuc(k)
    Case 1: w = " m" & ChrW$(432) & ChrW$(7901) & "i" + w
    Case 2: w = " hai m" & ChrW$(432) & ChrW$(417) & "i" + w
    Case 3: w = " ba m" & ChrW$(432) & ChrW$(417) & "i" + w
    Case 4: w = " b" & ChrW$(7889) & "n m" & ChrW$(432) & ChrW$(417) & "i" + w
    Case 5: w = " n" & ChrW$(259) & "m m" & ChrW$(432) & ChrW$(417) & "i" + w
    Case 6: w = " s" & ChrW$(225) & "u m" & ChrW$(432) & ChrW$(417) & "i" + w
    Case 7: w = " b" & ChrW$(7849) & "y m" & ChrW$(432) & ChrW$(417) & "i" + w
    Case 8: w = " t " & ChrW$(225) & "m m" & ChrW$(432) & ChrW$(417) & "i" + w
    Case 9: w = " ch" & ChrW$(237) & "n m" & ChrW$(432) & ChrW$(417) & "i" + w
    Case 0
    If tram(k) <> 0 And donvi(k) <> 0 Then
    w = " linh" + w
    End If
    End Select
    Select Case tram(k)
    Case 1: w = " m" & ChrW$(7897) & "t tr" & ChrW$(259) & "m" + w
    Case 2: w = " hai tr" & ChrW$(259) & "m" + w
    Case 3: w = " ba tr" & ChrW$(259) & "m" + w
    Case 4: w = " b" & ChrW$(7889) & "n tr" & ChrW$(259) & "m" + w
    Case 5: w = " n" & ChrW$(259) & "m tr" & ChrW$(259) & "m" + w
    Case 6: w = " s" & ChrW$(225) & "u tr" & ChrW$(259) & "m" + w
    Case 7: w = " b" & ChrW$(7849) & "y tr" & ChrW$(259) & "m" + w
    Case 8: w = " t" & ChrW$(225) & "m tr" & ChrW$(259) & "m" + w
    Case 9: w = " ch" & ChrW$(237) & "n tr" & ChrW$(259) & "m" + w
    Case 0
    If t > k And chuc(k) = 0 Then
    w = " kh" & ChrW$(244) & "ng tr" & ChrW$(259) & "m linh" + w
    End If

    If t > k And chuc(k) <> 0 Then
    w = " kh" & ChrW$(244) & "ng tr" & ChrW$(259) & "m" + w
    End If

    End Select
    Else
    w = w
    End If
    Next k
    ll = LTrim(w)
    If num < 0 Then
    Tung = " ¢m " & ll & ChrW$(273) & ChrW$(7891) & "ng" & w1 & "."
    Tung = Replace(Tung, " ", " ")
    Tung = Replace(Tung, " ", " ")
    Else
    Tung = "" & UCase(Left(ll, 1)) & Mid(ll, 2, Len(ll) - 1) & " " & ChrW$(273) & ChrW$(7891) & "ng ch" & ChrW$(7861) & "n " & w1 & "."
    Tung = Replace(Tung, " ", " ")
    Tung = Replace(Tung, " ", " ")
    End If

    End Function
     
    #3
  4. doremon1028

    doremon1028 Thành viên sơ cấp

    Bài viết:
    8
    Đã được thích:
    0
    Nơi ở:
    Ha Noi
    Mình ko biết cách làm như của các bạn, mình có xem trong diễn đàn cách đổi chữ ra số và cũng gặp TH giống như Tungbv. Cách đổi chữ ra số mà mình xem được là các bạn dùng hàm UPPER(LEFT(TRIM(IF.....
    Các bạn có thể giúp mình giải quyết vấn đề này với.
    Nếu có thể xin gửi qua địa chỉ mail: doremon1028@yahoo.com cho mình.
    Xin chân thành cảm ơn.
     
    #4
  5. fthaoabc

    fthaoabc Thành viên sơ cấp

    Bài viết:
    6
    Đã được thích:
    1
    Nơi ở:
    Yên Bái
    Tôi cũngđã viết một bài chuyển số ra chữ từ năm 2001 trên Web Lê Hoàn, hiện tại tôi đã viết thêm phần sửa lỗi để chuyển từ qua lại các font mã ABC<-->UNICODE, VNI<-->UNICODE...

    Bạn có thể xem cách làm cũ, còn cái mới tui sẽ post lên sau

    http://www.echip.com.vn/echiproot/weblh/ctv/2001/npthao/ttexcel/index.htm
     
    #5
  6. thainc

    thainc Thành viên sơ cấp

    Bài viết:
    2
    Đã được thích:
    0
    Nơi ở:
    hcm
    Xem thử cái này coi!
    http://nguyencaothai.5u.com
    hay http://caothaidhsp.topcities.com/huongdan.htm
     
    Last edited: 23 Tháng chín 2006
    #6
  7. thuyquan

    thuyquan Thành viên sơ cấp

    Bài viết:
    39
    Đã được thích:
    1
    Nơi ở:
    Da Lat
    cảm ơn anh Thái, nhưng...

    Trước tiên, thay mặt cho những người ... "chỉ biết dùng" và "hay thắc mắc" chân thành cảm ơn Anh Thái đã cung cung một chương trình khá hay và hữu ích cho dân KT!
    Sau khi cài đặt, em chạy thử thì gặp trục trặt rồi anh ui!
    em gõ =Ho("Nguyễn Hoàng Việt" thì chỉ ra được chữ "Nguyễn" thôi
    hoten(font Arial) họ tên
    Nguyễn Hoàng Việt Nguyễn Việt
    Vậy là sao hả anh, trong khi ở Sampe tải về em thấy anh làm được mừ. Giúp em với nha.
    Nếu có thể, anh mail cho em theo: cromatic_hg@yahoo.com.vn nhé. "Thanh kiều ve ri mút"
     
    #7
  8. vanhai

    vanhai Thành viên thân thiết

    Bài viết:
    56
    Đã được thích:
    0
    Nơi ở:
    HCM Cty
  9. ochuchoa

    ochuchoa Thành viên sơ cấp

    Bài viết:
    12
    Đã được thích:
    0
    Nơi ở:
    Da nang
    Phần đổi số ra chữ cũng có một lỗi nho nhỏ là sau chữ đồng vẫn còn chữ xu, cho dù không phải là số lẻ.
    Nghe "một trăm đồng xu" lạ tai quá xá hê hê
    Anh Thái sửa lại giúp anh em nhé vì file VBA có pw, có gì mail giúp ochuchoa về địa chỉ admin.spm@gmail.com
    Cảm ơn rất nhiều
     
    #9
  10. ochuchoa

    ochuchoa Thành viên sơ cấp

    Bài viết:
    12
    Đã được thích:
    0
    Nơi ở:
    Da nang
    Hàm này tuyệt vời, tớ đã sửa được chữ tỷ, cảm ơn :))
     
    #10

Chia sẻ trang này