Đổi số thành chữ (1 người xem)

[pconcord]

Chào cả nhà mình tham khảo vấn đề đổi số thành chữ nhiều mà vẫn không làm được, mình gửi file lên đây mong cả nhà giúp mình đổi số ở sheep Tổng cồng thành chữ dùm mình với. Tks cả nhà nhiều

 

[mhung12005]

Chào cả nhà mình tham khảo vấn đề đổi số thành chữ nhiều mà vẫn không làm được, mình gửi file lên đây mong cả nhà giúp mình đổi số ở sheep Tổng cồng thành chữ dùm mình với. Tks cả nhà nhiều

Bạn thử hàm tự tạo này xem sao nhé.

 

[pconcord]

Tks ban mhung12005 nhiều, còn nhiều file nữa mình cần chuyển số thành chữ, bạn hưỡng dẫn dùm mình cách đổi với, cảm ơn bạn nhiều!

 

[mhung12005]

Tks ban mhung12005 nhiều, còn nhiều file nữa mình cần chuyển số thành chữ, bạn hưỡng dẫn dùm mình cách đổi với, cảm ơn bạn nhiều!

Bạn làm như sau:

Mở file có số cần đổi --> nhấn Alt + F11 --> chọn thẻ Insert --> chọn Module. Trong cửa sổ module bạn dán cái sode này vào:

Function VN(Amt)
Dim Resp As String, Tien As String, Dem As String, Doc As String, NHOM As String
Dim Chu As String, So1 As String, So2 As String, So3 As String, Dich As String, Vitri As String
Dim i As Integer, j As Integer, S As Integer
If Amt = 0 Then
Resp = "Kh«ng ®ång"
Else
If Abs(Amt) > 999999999999.99 Then
Resp = "Sè qu¸ lín"
Else
If Amt < 0 Then
Resp = "Trõ "
Else
Resp = Space(0)
End If
Tien = Format(Abs(Amt), "###########0.00")
Tien = Right(Space(12) + Tien, 15)
Doc = Space(0): Dem = Doc
Doc = Doc + "tr¨m m&shy;¬i tû "
Doc = Doc + "tr¨m m&shy;¬i triÖu "
Doc = Doc + "tr¨m m&shy;¬i ngµn "
Doc = Doc + "tr¨m m&shy;¬i ®ång "
Dem = Dem + "mét hai ba bèn n¨m s¸u b¶y t¸m chÝn "
For i = 1 To 5
NHOM = Mid(Tien, i * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If i = 4 Then
Chu = "®ång"
Else
Chu = Space(0)
End If
Case ".00"
Chu = ""

Case Else
So1 = Left(NHOM, 1)
So2 = Mid(NHOM, 2, 1)
So3 = Right(NHOM, 1)
Chu = Space(0)
For j = 1 To 3
Dich = Space(0)
S = Val(Mid(NHOM, j, 1))
If S > 0 Then
Dich = Trim(Mid(Dem, S * 5 - 4, 5)) + " " + Trim(Mid(Doc, (i - 1) * 18 + j * 6 - 5, 6)) + " "
End If
Select Case j
Case 1 And S = 0 And i = 4 And (Abs(Amt) < 100 And Abs(Amt) >= 1)
Dich = Space(0)
Case 1 And S = 0 And i <> 1 And i <> 5
Dich = "kh«ng tr¨m "
Case 2 And S = 1
Dich = "m&shy;êi "
Case 3 And S = 0 And NHOM <> Space(2) + "0"
Dich = Trim(Mid(Doc, (i - 1) * 18 + j * 6 - 5, 6)) + Space(1)
Case 3 And S = 5 And So2 <> Space(1) And So2 <> "0"
Dich = "l" + Mid(Dich, 2)
Case 2 And S = 0 And So3 <> "0"
If (So1 >= "0" And So1 <= "9") Or (So1 = "0" And i = 4) Then
Dich = "lÎ "
End If
End Select
Chu = Chu + Dich
Next j
End Select
Vitri = InStr(1, Chu, "m&shy;¬i mét", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "m&shy;¬i mèt"
Resp = Resp + Chu
End If
Next i
End If
End If
If (Abs(Amt) < 10 ^ 8 And Abs(Amt) >= 10 ^ 6) Or (Abs(Amt) <= 99999 And Abs(Amt) >= 10 ^ 3) Then
VN = "B»ng ch÷: " + UCase(Mid(Resp, 12, 1)) + RTrim(Mid(Resp, 13)) + "."
Else
VN = "B»ng ch÷: " + UCase(Left(Resp, 1)) + RTrim(Mid(Resp, 2)) + "."
End If
End Function
Function VNU(Amt)
Dim Resp As String, Tien As String, Dem As String, Doc As String, NHOM As String
Dim Chu As String, So1 As String, So2 As String, So3 As String, Dich As String, Vitri As String
Dim i As Integer, j As Integer, S As Integer
If Amt = 0 Then
Resp = "Kh«ng ®ång"
Else
If Abs(Amt) > 999999999999.99 Then
Resp = "Sè qu¸ lín"
Else
If Amt < 0 Then
Resp = "Trõ "
Else
Resp = Space(0)
End If
Tien = Format(Abs(Amt), "###########0.00")
Tien = Right(Space(12) + Tien, 15)
Doc = Space(0): Dem = Doc
Doc = Doc + "tr¨m m&shy;¬i tû "
Doc = Doc + "tr¨m m&shy;¬i triÖu "
Doc = Doc + "tr¨m m&shy;¬i ngµn "
Doc = Doc + "tr¨m m&shy;¬i ®ång "
Dem = Dem + "mét hai ba bèn n¨m s¸u b¶y t¸m chÝn "
For i = 1 To 5
NHOM = Mid(Tien, i * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If i = 4 Then
Chu = "®ång"
Else
Chu = Space(0)
End If
Case ".00"
Chu = ""
Case Else
So1 = Left(NHOM, 1)
So2 = Mid(NHOM, 2, 1)
So3 = Right(NHOM, 1)
Chu = Space(0)
For j = 1 To 3
Dich = Space(0)
S = Val(Mid(NHOM, j, 1))
If S > 0 Then
Dich = Trim(Mid(Dem, S * 5 - 4, 5)) + " " + Trim(Mid(Doc, (i - 1) * 18 + j * 6 - 5, 6)) + " "
End If
Select Case j
Case 1 And S = 0 And i = 4 And (Abs(Amt) < 100 And Abs(Amt) >= 1)
Dich = Space(0)
Case 1 And S = 0 And i <> 1 And i <> 5
Dich = "kh«ng tr¨m "
Case 2 And S = 1
Dich = "m&shy;êi "
Case 3 And S = 0 And NHOM <> Space(2) + "0"
Dich = Trim(Mid(Doc, (i - 1) * 18 + j * 6 - 5, 6)) + Space(1)
Case 3 And S = 5 And So2 <> Space(1) And So2 <> "0"
Dich = "l" + Mid(Dich, 2)
Case 2 And S = 0 And So3 <> "0"
If (So1 >= "0" And So1 <= "9") Or (So1 = "0" And i = 4) Then
Dich = "lÎ "
End If
End Select
Chu = Chu + Dich
Next j
End Select
Vitri = InStr(1, Chu, "m&shy;¬i mét", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "m&shy;¬i mèt"
Resp = Resp + Chu
End If
Next i
End If
End If
If (Abs(Amt) < 10 ^ 8 And Abs(Amt) >= 10 ^ 6) Or (Abs(Amt) <= 99999 And Abs(Amt) >= 10 ^ 3) Then
VNU = UNI("B»ng ch÷: " & UCase(Mid(Resp, 12, 1)) + RTrim(Mid(Resp, 13)) + ".")
Else
VNU = UNI("B»ng ch÷: " & UCase(Left(Resp, 1)) + RTrim(Mid(Resp, 2)) + ".")
End If
End Function
Function VNUNI(So)
Dim Doc As String
Doc = VN(Abs(So))
VNUNI = UNI(Doc)
End Function
Function UNI(vnstr As String) As String
Dim c As String, i As Integer
For i = 1 To Len(vnstr)
c = Mid(vnstr, i, 1)
Select Case c
Case "a": c = ChrW$(97)
Case "¸": c = ChrW$(225)
Case "µ": c = ChrW$(224)
Case "¶": c = ChrW$(7843)
Case "·": c = ChrW$(227)
Case "¹": c = ChrW$(7841)
Case "¨": c = ChrW$(259)
Case "¾": c = ChrW$(7855)
Case "»": c = ChrW$(7857)
Case "¼": c = ChrW$(7859)
Case "½": c = ChrW$(7861)
Case "Æ": c = ChrW$(7863)
Case "©": c = ChrW$(226)
Case "Ê": c = ChrW$(7845)
Case "Ç": c = ChrW$(7847)
Case "È": c = ChrW$(7849)
Case "É": c = ChrW$(7851)
Case "Ë": c = ChrW$(7853)
Case "e": c = ChrW$(101)
Case "Ð": c = ChrW$(233)
Case "Ì": c = ChrW$(232)
Case "Î": c = ChrW$(7867)
Case "Ï": c = ChrW$(7869)
Case "Ñ": c = ChrW$(7865)
Case "ª": c = ChrW$(234)
Case "Õ": c = ChrW$(7871)
Case "Ò": c = ChrW$(7873)
Case "Ó": c = ChrW$(7875)
Case "Ô": c = ChrW$(7877)
Case "Ö": c = ChrW$(7879)
Case "o": c = ChrW$(111)
Case "ã": c = ChrW$(243)
Case "ß": c = ChrW$(242)
Case "á": c = ChrW$(7887)
Case "â": c = ChrW$(245)
Case "ä": c = ChrW$(7885)
Case "«": c = ChrW$(244)
Case "è": c = ChrW$(7889)
Case "å": c = ChrW$(7891)
Case "æ": c = ChrW$(7893)
Case "ç": c = ChrW$(7895)
Case "é": c = ChrW$(7897)
Case "¬": c = ChrW$(417)
Case "í": c = ChrW$(7899)
Case "ê": c = ChrW$(7901)
Case "ë": c = ChrW$(7903)
Case "ì": c = ChrW$(7905)
Case "î": c = ChrW$(7907)
Case "i": c = ChrW$(105)
Case "Ý": c = ChrW$(237)
Case "×": c = ChrW$(236)
Case "Ø": c = ChrW$(7881)
Case "Ü": c = ChrW$(297)
Case "Þ": c = ChrW$(7883)
Case "u": c = ChrW$(117)
Case "ó": c = ChrW$(250)
Case "ï": c = ChrW$(249)
Case "ñ": c = ChrW$(7911)
Case "ò": c = ChrW$(361)
Case "ô": c = ChrW$(7909)
'Case "*": c = ChrW$(432)
Case "&shy;": c = ChrW$(432)
Case "ø": c = ChrW$(7913)
Case "õ": c = ChrW$(7915)
Case "ö": c = ChrW$(7917)
Case "÷": c = ChrW$(7919)
Case "ù": c = ChrW$(7921)
Case "y": c = ChrW$(121)
Case "ý": c = ChrW$(253)
Case "ú": c = ChrW$(7923)
Case "û": c = ChrW$(7927)
Case "ü": c = ChrW$(7929)
Case "þ": c = ChrW$(7925)
Case "®": c = ChrW$(273)
Case "A": c = ChrW$(65)
Case "¡": c = ChrW$(258)
Case "¢": c = ChrW$(194)
Case "E": c = ChrW$(69)
Case "£": c = ChrW$(202)
Case "O": c = ChrW$(79)
Case "¤": c = ChrW$(212)
Case "¥": c = ChrW$(416)
Case "I": c = ChrW$(73)
Case "U": c = ChrW$(85)
Case "¦": c = ChrW$(431)
Case "Y": c = ChrW$(89)
Case "§": c = ChrW$(272)
End Select
UNI = UNI + c
Next i
End Function

Nhấn Alt + Q để thoát khỏi VBE.

Bây giờ bạn sử dụng như hàm excel bình thường thôi.

VD: ô A1 là ô chứa số cần đổi thì tại B1 (hay ô nào đó) bạn nhập =VNU(A1) với font là Times New Roman.
Còn với font .VnTime thì bạn nhập =vn(A1). Xem kết quả.

 

[pconcord]

Tks ban nhiều, mình thử làm như bạn chỉ dẫn nhưng lại bị lỗi thế này, bạn xem dùm mình sửa thể nào đây, mình để font Times New Roman rồi, Tks bạn nhiều nhiều.

 

[mhung12005]

Tks ban nhiều, mình thử làm như bạn chỉ dẫn nhưng lại bị lỗi thế này, bạn xem dùm mình sửa thể nào đây, mình để font Times New Roman rồi, Tks bạn nhiều nhiều.

Mình làm vẫn được bình thường. Hay bạn copy trực tiếp code trong file này và dán vào file bạn cần xem sao.

 

[thomtv]

Chào cả nhà mình tham khảo vấn đề đổi số thành chữ nhiều mà vẫn không làm được, mình gửi file lên đây mong cả nhà giúp mình đổi số ở sheep Tổng cồng thành chữ dùm mình với. Tks cả nhà nhiều

vào đây xem bài 147 nhe: http://www.giaiphapexcel.com/forum/...g-chữ-trong-Excel-sử-dụng-font-Unicode/page15

 

[pconcord]

Mình copy trực tiếp code của bạn vẫn không được? hay có phải cài cái gì nữa không?làm cả 1 buổi sáng không được, bực mình quá, hix!

 

[mhung12005]

Mình copy trực tiếp code của bạn vẫn không được? hay có phải cài cái gì nữa không?làm cả 1 buổi sáng không được, bực mình quá, hix!

Nếu bạn vẫn không làm được thì cho file lên mình làm giúp thôi, chứ tất cả những gì cần hướng dẫn thì mình đã nói cả rồi.

Thân.

 

[hoamattroicoi]

Sao không sử dụng VnTool ở đây nhỉ?

 

[pconcord]

Bạn mhung12005 có mail không? mình gửi qua mail cho bạn, gửi lên đây không tiện, Tks bạn nhiều!

 

[mhung12005]

Bạn mhung12005 có mail không? mình gửi qua mail cho bạn, gửi lên đây không tiện, Tks bạn nhiều!

Địa chỉ mail của mình:

nhung868@gmail.com

 

[pconcord]

Mình gửi qua mail rồi, bạn xem dùm mình cái nhé. Tks ban nhieu!

 

[thomtv]

Nếu bạn vẫn không làm được thì cho file lên mình làm giúp thôi, chứ tất cả những gì cần hướng dẫn thì mình đã nói cả rồi.

Thân.

nó bị lỗi này #NAME, đúng ko?
Nếu thấy báo lỗi: #NAME thì thực hiện theo cách sau:
Đối với Execl 2007:
Vào office botton chọn vào Execl options (hay phím tắc I ), chọn trust center, ở khung giữa chọn vào chữ trust center settings… và chọn vào chấm có dòng chữ Enable all macros (not….) sau đó ok tất cả. Lưu văn bản đó lại tắt và mỡ văn bản đó lại. (save => close => open)
Đối với Execl 2003:
Chọn vào tools => macro => security => chọm vào chấm Clow. sau đó ok tất cả. Lưu văn bản đó lại tắt và mỡ văn bản đó lại. (save => close => open)