Viết hàm từ số tự động đọc sang chữ

Liên hệ QC

luaminep

Thành viên mới
Tham gia
6/12/12
Bài viết
3
Được thích
0
Em muốn hỏi mọi người muốn viết số vào 1 ô khi enter ô khác sẽ tự nhảy chữ
VD: viết 1.000.000 ô khác tự động nhảy chữ "Một triệu đồng"
 
Em muốn hỏi mọi người muốn viết số vào 1 ô khi enter ô khác sẽ tự nhảy chữ
VD: viết 1.000.000 ô khác tự động nhảy chữ "Một triệu đồng"
Làm gì có chuyện có gõ số ở 1 ô Enter mà lại ra chữ ở ô khác
Trừ khi Ô khác = vnd()
hoặc ô khác = sorachu()
 
Thì ý mình muốn viết công thức hàm nào để có thể hiện ra chữ
 
Thì ý mình muốn viết công thức hàm nào để có thể hiện ra chữ
Bạn chép đoạn Code dưới vào Module trong cửa sổ VBA
nhập công thức =sorachu(A1) với A1 là ô chứa số , chọn fonts Times New Roman
Mã:
Function UnicodeChar(UniCharCode As String) As String

On Error GoTo Loi

Dim str

Dim desStr As String

Dim I

If Mid(UniCharCode, 1, 1) = ";" Then

UniCharCode = Mid(UniCharCode, 2)

End If

If Right(UniCharCode, 1) = ";" Then

UniCharCode = Mid(UniCharCode, 1, Len(UniCharCode) - 1)

End If

str = UniCharCode

str = Split(str, ";")

For I = LBound(str) To UBound(str)

desStr = desStr & ChrW$("&H" & str(I))

Next

UnicodeChar = desStr

Loi:

Exit Function

End Function

Function SoRaChu(ByVal NumCurrency As Currency) As String

Static CharVND(9) As String, BangChu As String, I As Integer

Dim SoLe, SoDoi As Integer, PhanChan, Ten As String

Dim DonViTien As String, DonViLe As String

Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer

Dim Dong As Integer, Tram As Integer, Muoi As Integer, DonVi As Integer

DonViTien = ";111;1ED3;6E;67"  ' ?o^`ng

DonViLe = ";78;75" ' xu

If NumCurrency = 0 Then

SoRaChu = UnicodeChar(";4B;68;F4;6E;67;20" & DonViTien)

Exit Function

End If

If NumCurrency > 922337203685477# Then ' So^' lo+'n nha^'t cu?a loa.i CURRENCY

SoRaChu = UnicodeChar(";4B;68;F4;6E;67;20;111;1ED5;69;20;111;1B0;1EE3;63;20;73" & _

";1ED1;20;6C;1EDB;6E;20;68;1A1;6E;20;39;32;32;2C;33;33;37" & _

";2C;32;30;33;2C;36;38;35;2C;34;37;37")

Exit Function

End If

CharVND(1) = ";6D;1ED9;74" ' mo^.t

CharVND(2) = ";68;61;69" ' hai

CharVND(3) = ";62;61" ' ba

CharVND(4) = ";62;1ED1;6E" ' bo^'n

CharVND(5) = ";6E;103;6D" ' na(m

CharVND(6) = ";73;E1;75" ' su

CharVND(7) = ";62;1EA3;79" ' ba?y

CharVND(8) = ";74;E1;6D" ' tm

CharVND(9) = ";63;68;ED;6E" ' chn

CharVND(0) = ";78;75"

SoLe = Int((NumCurrency - Int(NumCurrency)) * 100) ' 2 k so^'

PhanChan = Trim$(str$(Int(NumCurrency)))

PhanChan = Space(15 - Len(PhanChan)) + PhanChan

NganTy = Val(Left(PhanChan, 3))

Ty = Val(Mid$(PhanChan, 4, 3))

Trieu = Val(Mid$(PhanChan, 7, 3))

Ngan = Val(Mid$(PhanChan, 10, 3))

Dong = Val(Mid$(PhanChan, 13, 3))

If NganTy = 0 And Ty = 0 And Trieu = 0 And Ngan = 0 And Dong = 0 Then

BangChu = ";6B;68;F4;6E;67;20" + DonViTien + ";20"

I = 5

Else

BangChu = ""

I = 0

End If

'-----------------------------------------------------

' Ba('t ?a^`u ?o^?i

'-----------------------------------------------------

While I <= 5

Select Case I

Case 0

SoDoi = NganTy

Ten = ";6E;67;68;EC;6E;20;74;1EF7" 'ngh×n ty?

Case 1

SoDoi = Ty

Ten = ";74;1EF7" ' ty?

Case 2

SoDoi = Trieu

Ten = ";74;72;69;1EC7;75" ' trie^.u

Case 3

SoDoi = Ngan

Ten = ";6E;67;68;EC;6E" 'ngh×n

Case 4

SoDoi = Dong

Ten = DonViTien ' ?o^`ng

Case 5

SoDoi = SoLe

Ten = DonViLe ' xu

End Select

If SoDoi <> 0 Then

Tram = Int(SoDoi / 100)

Muoi = Int((SoDoi - Tram * 100) / 10)

DonVi = (SoDoi - Tram * 100) - Muoi * 10

If Right(BangChu, 3) = ";20" Then

BangChu = Left(BangChu, Len(BangChu) - 3)

End If

BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";2C;20") + _

IIf(Tram <> 0, Trim(CharVND(Tram)) + ";20;74;72;103;6D;20", "")

If Muoi = 0 And Tram <> 0 And DonVi <> 0 Then

BangChu = BangChu + ";6C;1EBB;20"

Else

If Muoi <> 0 Then

BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, _

Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20")

End If

End If

If Muoi <> 0 And DonVi = 5 Then

BangChu = BangChu + ";6C;103;6D;20" + Ten + ";20"

Else

If Muoi > 1 And DonVi = 1 Then

BangChu = BangChu + ";6D;1ED1;74;20" + Ten + ";20"

Else

BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten) + ";20"

End If

End If

Else

BangChu = BangChu + IIf(I = 4, DonViTien + "", "")

End If

I = I + 1

Wend

If Right(BangChu, 3) = ";20" Then

BangChu = Left(BangChu, Len(BangChu) - 3)

End If

BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";2e;20")

If SoLe = 0 Then

BangChu = BangChu + IIf(Right(BangChu, 3) = 0, "", ";20")

End If

BangChu = UnicodeChar(BangChu)

'?o^?i sang tie^'ng Vie^.t Unicode

' ?o^?i chu+~ ci ?a^`u tin thnh chu+~ hoa

Mid$(BangChu, 1, 1) = UCase$(Mid$(BangChu, 1, 1))

SoRaChu = BangChu

End Function
 
Lần chỉnh sửa cuối:
CÓ hàm không anh LeVan? em biết cách copy và cho đoạn code chạy nhưng không hiểu gì hết ạ..+-+-+-+
 
lần đầu tiên mình sử dụng hàm exel ban cos thể chỉ cụ thể hơn cho minh được ko, mình ko biết vào VBA
Cảm ơn trươc nhiều nhiều
 
lần đầu tiên mình sử dụng hàm exel ban cos thể chỉ cụ thể hơn cho minh được ko, mình ko biết vào VBA
Cảm ơn trươc nhiều nhiều
1) Cảm ơn ai thì dưới mỗi bài viết của người ta đều có nút "Cảm ơn"
2) Mở Excel nhấn Alt + F11. Chọn Insert Module . Copy đoạn code bài #4 và Paste vào màn hình vừa tạo bên phải. nhấn Alt+Q
Sử dụng hàm như bài #4
 
lần đầu tiên mình sử dụng hàm exel ban cos thể chỉ cụ thể hơn cho minh được ko, mình ko biết vào VBA
Cảm ơn trươc nhiều nhiều

Bạn làm như cách sau nhé, tớ thử rồi chạy được đó (MẶC DÙ TỚ KHÔNG BIẾT VIẾT CODE)
CÁCH CHẠY VBA COPY
Bạn mở 1 file Excel nhấn Alt+F11 chọn Insert Module và Copy code trên Paste vào Module vừa tạo
Nhấn Alt+Q
Tại cửa sổ Excel tại D7=Ghep(C7) Enter --->OK
 
1) Cảm ơn ai thì dưới mỗi bài viết của người ta đều có nút "Cảm ơn"
2) Mở Excel nhấn Alt + F11. Chọn Insert Module . Copy đoạn code bài #4 và Paste vào màn hình vừa tạo bên phải. nhấn Alt+Q
Sử dụng hàm như bài #4

Em nhấn cảm ơn rồi mà hihi, hay đó Anh Vanle nhưng còn điều này nữa em muốn hỏi thêm này.
Code thường thì ở dạng Macro kiểu (Sub gì đó()... End Sub) thì sẽ được lưu trong Module. Bạn làm như sau: Nhấn Alt + F11 -> Nhấn phải chuột lên các tên sheet -> Chọn Insert Module -> Rồi Paste vào trong Module đó. Để chạy thì có thể nhấn vào lệnh Run (Hình mũi tên xanh phía trên) hoặc vào lại trang bảng tính Excel nhấn Alt + F8 -> Chọn tên sub vừa rồi -> Run.

Còn 1 số code khác có định dạng kiểu (Function gì đó(...) ... End Function) thì cũng nằm trong Module nhưng không chạy được bằng lệnh Run mà phải chạy chúng kiểu như dùng các hàm IF, SUM hay SUMPRODUCT vậy.

Còn 1 dạng code cuối cùng là các code thường được bắt đầu bằng Private Sub Worksheet hoặc Private Sub Workbook thì đặt chúng trong các tên Sheet ở VBA hoặc nằm trong ThisWorkbook luôn.


Thế làm sao biết được code viết như thế nào để mà biết cách cho nó chạy ạ???em mới lội xuống nước thôi, chưa bơi được "TRỜI MẤY LÂU NAY LẠNH" nên rét lắm huhu...
Nhưng sẽ cố gắng ...!giải thích giùm em nha.
 
Cái này trên mạng có rất nhiều rồi, dowload về add-in là xong mà.
 
Em nhấn cảm ơn rồi mà hihi, hay đó Anh Vanle nhưng còn điều này nữa em muốn hỏi thêm này.
Code thường thì ở dạng Macro kiểu (Sub gì đó()... End Sub) thì sẽ được lưu trong Module. Bạn làm như sau: Nhấn Alt + F11 -> Nhấn phải chuột lên các tên sheet -> Chọn Insert Module -> Rồi Paste vào trong Module đó. Để chạy thì có thể nhấn vào lệnh Run (Hình mũi tên xanh phía trên) hoặc vào lại trang bảng tính Excel nhấn Alt + F8 -> Chọn tên sub vừa rồi -> Run.

Còn 1 số code khác có định dạng kiểu (Function gì đó(...) ... End Function) thì cũng nằm trong Module nhưng không chạy được bằng lệnh Run mà phải chạy chúng kiểu như dùng các hàm IF, SUM hay SUMPRODUCT vậy.

Còn 1 dạng code cuối cùng là các code thường được bắt đầu bằng Private Sub Worksheet hoặc Private Sub Workbook thì đặt chúng trong các tên Sheet ở VBA hoặc nằm trong ThisWorkbook luôn.


Thế làm sao biết được code viết như thế nào để mà biết cách cho nó chạy ạ???em mới lội xuống nước thôi, chưa bơi được "TRỜI MẤY LÂU NAY LẠNH" nên rét lắm huhu...
Nhưng sẽ cố gắng ...!giải thích giùm em nha.
1) A nói thành viên kia chưa biết cám ơn thì a hướng dẫn vậy, a ko nói cô chưa cảm ơn. hiii
2) Như những dòng chữ xanh của cô đó
Hàm ở đây là =sorachu()
Quan trọng là cô đã thử và chạy được Code chưa?
Ví dụ A1=123456 thì B1 là Một trăm hai mươi ba nghìn, bốn trăm năm mươi sáu đồng. chưa???
 
1) A nói thành viên kia chưa biết cám ơn thì a hướng dẫn vậy, a ko nói cô chưa cảm ơn. hiii
2) Như những dòng chữ xanh của cô đó
Hàm ở đây là =sorachu()
Quan trọng là cô đã thử và chạy được Code chưa?
Ví dụ A1=123456 thì B1 là Một trăm hai mươi ba nghìn, bốn trăm năm mươi sáu đồng. chưa???


Em trêu tí cho vui thôi mà.hihi, em cho chạy thử rồi, Anh xem file nha, nhưng ý em hỏi là nhận biết dạng code để mà chạy cơ "dòng chữ màu xanh" ạ.
 

File đính kèm

  • SUMIF.xls
    44 KB · Đọc: 24
Em nhấn cảm ơn rồi mà hihi, hay đó Anh Vanle nhưng còn điều này nữa em muốn hỏi thêm này.
Code thường thì ở dạng Macro kiểu (Sub gì đó()... End Sub) thì sẽ được lưu trong Module. Bạn làm như sau: Nhấn Alt + F11 -> Nhấn phải chuột lên các tên sheet -> Chọn Insert Module -> Rồi Paste vào trong Module đó. Để chạy thì có thể nhấn vào lệnh Run (Hình mũi tên xanh phía trên) hoặc vào lại trang bảng tính Excel nhấn Alt + F8 -> Chọn tên sub vừa rồi -> Run.

Còn 1 số code khác có định dạng kiểu (Function gì đó(...) ... End Function) thì cũng nằm trong Module nhưng không chạy được bằng lệnh Run mà phải chạy chúng kiểu như dùng các hàm IF, SUM hay SUMPRODUCT vậy.

Còn 1 dạng code cuối cùng là các code thường được bắt đầu bằng Private Sub Worksheet hoặc Private Sub Workbook thì đặt chúng trong các tên Sheet ở VBA hoặc nằm trong ThisWorkbook luôn.


Thế làm sao biết được code viết như thế nào để mà biết cách cho nó chạy ạ???em mới lội xuống nước thôi, chưa bơi được "TRỜI MẤY LÂU NAY LẠNH" nên rét lắm huhu...
Nhưng sẽ cố gắng ...!giải thích giùm em nha.

Thấy bạn hỏi ngu ngơ giống như mình một vài năm về trước, bạn hãy đi tìm với từ khóa Private và Public thì sẽ biết, mình giải thích sơ qua cho bạn (hoặc bạn nào chưa biết), vì đây không phải là chủ đề của Toppic này.

Private và Public là các từ khóa thường dùng để đứng trước thủ tục (Sub) hoặc hàm (Function) để giới hạn phạm vi hoạt động/sử dụng của thủ tục hoặc hàm đó. (Ngoài ra còn có các từ khóa khác nhưng trong VBA thông thường hầu như không sử dụng. Khi nào bạn nghiên cứu đến tầm cao hơn như API, Class ... sẽ biết thêm)

- Khi đặt Private trước từ khóa Sub hoặc Function nào thì thủ tục/hàm đó chỉ dùng được trong Module nó đang đứng.

- Khi đặt Public trước từ khóa Sub hoặc Function thì thủ tục/hàm đó được dùng chung cho tất cả các Module, Sheet, ThisWorkbook. Khi không đặt gì thì VB/VBA ngầm mặc định là Public. Nhưng muốn dùng chung lại còn phải đặt thủ tục/hàm trong module. Đặt thủ tục/hàm trong Sheet không thể dùng chung và không dùng trên Cells được. Vì vậy người ta thường đặt code trong module nhất là đối với hàm, muốn dùng trên Cells thì nhất thiết phải đặt trong Module.

- Vì thủ tục/hàm đặt trong Sheet chỉ hoạt động được trong Sheet đó nên bạn có cho nó là Public cũng chẳng tác dụng gì. Vì vậy trong Sheet, Workbook chỉ có thể và thường là Private.

Bạn hãy thí nghiệm bằng cách sau: Dời hai thủ tục này đi khắp các nơi: Module1, Module2, Sheet1, Sheet2 ... ; có và không có Private đứng trước.

'Thủ tuc1
Sub MySub1()
MsgBox "MySub1 co mat"
End Sub

'Thủ tuc2 "goi thủ tục 1"
Sub MySub2()
MySub1
End Sub

Sau một hồi cắt, dán, thêm Private, xóa Private, Run, OK ... khi nào nó chóng mặt thì bạn sẽ rút ra được kinh nghệm cho mình.
-------
Còn nữa, kỳ tới: Hàm/thủ tục có chứa tham số. (Bạn nào viết giùm!)
 
Thì cứ xài đi, hiểu chi cho mệt hả em. Biết áp dụng là mừng rồi. Anh cũng như em thôi.
Anh này khéo nói đùa ghê, lão tổ về code mà khiêm tốn thế
Biết áp dụng là mừng rồi. Anh cũng như em thôi.
,
nếu chưa thoả mản thì mần tiếp. Mình thì kiểu gì cũng mần hết. Hỏng trúng ráng chịu.
nhưng thừa nhận code này nhìn vô phê quá. có cách ngăn hơn ko????
 
Bạn chép đoạn Code dưới vào Module trong cửa sổ VBA
nhập công thức =sorachu(A1) với A1 là ô chứa số , chọn fonts Times New Roman


Function UnicodeChar(UniCharCode As String) As String
On Error GoTo Loi
Dim str
Dim desStr As String
Dim I
If Mid(UniCharCode, 1, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 2)
End If
If Right(UniCharCode, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 1, Len(UniCharCode) - 1)
End If
str = UniCharCode
str = Split(str, ";")
For I = LBound(str) To UBound(str)
desStr = desStr & ChrW$("&H" & str(I))
Next
UnicodeChar = desStr
Loi:
Exit Function
End Function
Function SoRaChu(ByVal NumCurrency As Currency) As String
Static CharVND(9) As String, BangChu As String, I As Integer
Dim SoLe, SoDoi As Integer, PhanChan, Ten As String
Dim DonViTien As String, DonViLe As String
Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer
Dim Dong As Integer, Tram As Integer, Muoi As Integer, DonVi As Integer
DonViTien = ";111;1ED3;6E;67" ' ?o^`ng
DonViLe = ";78;75" ' xu
If NumCurrency = 0 Then
SoRaChu = UnicodeChar(";4B;68;F4;6E;67;20" & DonViTien)
Exit Function
End If
If NumCurrency > 922337203685477# Then ' So^' lo+'n nha^'t cu?a loa.i CURRENCY
SoRaChu = UnicodeChar(";4B;68;F4;6E;67;20;111;1ED5;69;20;111;1B0;1EE3;63;20;73" & _
";1ED1;20;6C;1EDB;6E;20;68;1A1;6E;20;39;32;32;2C;33;33;37" & _
";2C;32;30;33;2C;36;38;35;2C;34;37;37")
Exit Function
End If
CharVND(1) = ";6D;1ED9;74" ' mo^.t
CharVND(2) = ";68;61;69" ' hai
CharVND(3) = ";62;61" ' ba
CharVND(4) = ";62;1ED1;6E" ' bo^'n
CharVND(5) = ";6E;103;6D" ' na(m
CharVND(6) = ";73;E1;75" ' su
CharVND(7) = ";62;1EA3;79" ' ba?y
CharVND(8) = ";74;E1;6D" ' tm
CharVND(9) = ";63;68;ED;6E" ' chn
CharVND(0) = ";78;75"
SoLe = Int((NumCurrency - Int(NumCurrency)) * 100) ' 2 k so^'
PhanChan = Trim$(str$(Int(NumCurrency)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan
NganTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Ngan = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
If NganTy = 0 And Ty = 0 And Trieu = 0 And Ngan = 0 And Dong = 0 Then
BangChu = ";6B;68;F4;6E;67;20" + DonViTien + ";20"
I = 5
Else
BangChu = ""
I = 0
End If
'-----------------------------------------------------
' Ba('t ?a^`u ?o^?i
'-----------------------------------------------------
While I <= 5
Select Case I
Case 0
SoDoi = NganTy
Ten = ";6E;67;68;EC;6E;20;74;1EF7" 'ngh×n ty?
Case 1
SoDoi = Ty
Ten = ";74;1EF7" ' ty?
Case 2
SoDoi = Trieu
Ten = ";74;72;69;1EC7;75" ' trie^.u
Case 3
SoDoi = Ngan
Ten = ";6E;67;68;EC;6E" 'ngh×n
Case 4
SoDoi = Dong
Ten = DonViTien ' ?o^`ng
Case 5
SoDoi = SoLe
Ten = DonViLe ' xu
End Select
If SoDoi <> 0 Then
Tram = Int(SoDoi / 100)
Muoi = Int((SoDoi - Tram * 100) / 10)
DonVi = (SoDoi - Tram * 100) - Muoi * 10
If Right(BangChu, 3) = ";20" Then
BangChu = Left(BangChu, Len(BangChu) - 3)
End If
BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";2C;20") + _
IIf(Tram <> 0, Trim(CharVND(Tram)) + ";20;74;72;103;6D;20", "")
If Muoi = 0 And Tram <> 0 And DonVi <> 0 Then
BangChu = BangChu + ";6C;1EBB;20"
Else
If Muoi <> 0 Then
BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, _
Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20")
End If
End If
If Muoi <> 0 And DonVi = 5 Then
BangChu = BangChu + ";6C;103;6D;20" + Ten + ";20"
Else
If Muoi > 1 And DonVi = 1 Then
BangChu = BangChu + ";6D;1ED1;74;20" + Ten + ";20"
Else
BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten) + ";20"
End If
End If
Else
BangChu = BangChu + IIf(I = 4, DonViTien + "", "")
End If
I = I + 1
Wend
If Right(BangChu, 3) = ";20" Then
BangChu = Left(BangChu, Len(BangChu) - 3)
End If
BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";2e;20")
If SoLe = 0 Then
BangChu = BangChu + IIf(Right(BangChu, 3) = 0, "", ";20")
End If
BangChu = UnicodeChar(BangChu)
'?o^?i sang tie^'ng Vie^.t Unicode
' ?o^?i chu+~ ci ?a^`u tin thnh chu+~ hoa
Mid$(BangChu, 1, 1) = UCase$(Mid$(BangChu, 1, 1))
SoRaChu = BangChu
End Function
1) Cảm ơn ai thì dưới mỗi bài viết của người ta đều có nút "Cảm ơn"
2) Mở Excel nhấn Alt + F11. Chọn Insert Module . Copy đoạn code bài #4 và Paste vào màn hình vừa tạo bên phải. nhấn Alt+Q
Sử dụng hàm như bài #4
Anh ơi cho em hỏi là, e dùng hàm anh chỉ đã ra được phép hết rồi, tuy nhiên khi save dưới dạng macro thì mở lại, hàm lại bị lỗi #name ạ
 
Anh ơi cho em hỏi là, e dùng hàm anh chỉ đã ra được phép hết rồi, tuy nhiên khi save dưới dạng macro thì mở lại, hàm lại bị lỗi #name ạ
Bạn save file định dạng .xls (hoặc .xlsm hoặc .xlsb) chưa? Nếu save thành .xlsx là code trong file bị tiêu diệt luôn đó.
[Các kiểu định dạng file là trong mục Save as type đó khi thực hiện Save as file đó (tương đương nhấn F12)].
 
Bạn chép đoạn Code dưới vào Module trong cửa sổ VBA
nhập công thức =sorachu(A1) với A1 là ô chứa số , chọn fonts Times New Roman


Function UnicodeChar(UniCharCode As String) As String
On Error GoTo Loi
Dim str
Dim desStr As String
Dim I
If Mid(UniCharCode, 1, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 2)
End If
If Right(UniCharCode, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 1, Len(UniCharCode) - 1)
End If
str = UniCharCode
str = Split(str, ";")
For I = LBound(str) To UBound(str)
desStr = desStr & ChrW$("&H" & str(I))
Next
UnicodeChar = desStr
Loi:
Exit Function
End Function
Function SoRaChu(ByVal NumCurrency As Currency) As String
Static CharVND(9) As String, BangChu As String, I As Integer
Dim SoLe, SoDoi As Integer, PhanChan, Ten As String
Dim DonViTien As String, DonViLe As String
Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer
Dim Dong As Integer, Tram As Integer, Muoi As Integer, DonVi As Integer
DonViTien = ";111;1ED3;6E;67" ' ?o^`ng
DonViLe = ";78;75" ' xu
If NumCurrency = 0 Then
SoRaChu = UnicodeChar(";4B;68;F4;6E;67;20" & DonViTien)
Exit Function
End If
If NumCurrency > 922337203685477# Then ' So^' lo+'n nha^'t cu?a loa.i CURRENCY
SoRaChu = UnicodeChar(";4B;68;F4;6E;67;20;111;1ED5;69;20;111;1B0;1EE3;63;20;73" & _
";1ED1;20;6C;1EDB;6E;20;68;1A1;6E;20;39;32;32;2C;33;33;37" & _
";2C;32;30;33;2C;36;38;35;2C;34;37;37")
Exit Function
End If
CharVND(1) = ";6D;1ED9;74" ' mo^.t
CharVND(2) = ";68;61;69" ' hai
CharVND(3) = ";62;61" ' ba
CharVND(4) = ";62;1ED1;6E" ' bo^'n
CharVND(5) = ";6E;103;6D" ' na(m
CharVND(6) = ";73;E1;75" ' su
CharVND(7) = ";62;1EA3;79" ' ba?y
CharVND(8) = ";74;E1;6D" ' tm
CharVND(9) = ";63;68;ED;6E" ' chn
CharVND(0) = ";78;75"
SoLe = Int((NumCurrency - Int(NumCurrency)) * 100) ' 2 k so^'
PhanChan = Trim$(str$(Int(NumCurrency)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan
NganTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Ngan = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
If NganTy = 0 And Ty = 0 And Trieu = 0 And Ngan = 0 And Dong = 0 Then
BangChu = ";6B;68;F4;6E;67;20" + DonViTien + ";20"
I = 5
Else
BangChu = ""
I = 0
End If
'-----------------------------------------------------
' Ba('t ?a^`u ?o^?i
'-----------------------------------------------------
While I <= 5
Select Case I
Case 0
SoDoi = NganTy
Ten = ";6E;67;68;EC;6E;20;74;1EF7" 'ngh×n ty?
Case 1
SoDoi = Ty
Ten = ";74;1EF7" ' ty?
Case 2
SoDoi = Trieu
Ten = ";74;72;69;1EC7;75" ' trie^.u
Case 3
SoDoi = Ngan
Ten = ";6E;67;68;EC;6E" 'ngh×n
Case 4
SoDoi = Dong
Ten = DonViTien ' ?o^`ng
Case 5
SoDoi = SoLe
Ten = DonViLe ' xu
End Select
If SoDoi <> 0 Then
Tram = Int(SoDoi / 100)
Muoi = Int((SoDoi - Tram * 100) / 10)
DonVi = (SoDoi - Tram * 100) - Muoi * 10
If Right(BangChu, 3) = ";20" Then
BangChu = Left(BangChu, Len(BangChu) - 3)
End If
BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";2C;20") + _
IIf(Tram <> 0, Trim(CharVND(Tram)) + ";20;74;72;103;6D;20", "")
If Muoi = 0 And Tram <> 0 And DonVi <> 0 Then
BangChu = BangChu + ";6C;1EBB;20"
Else
If Muoi <> 0 Then
BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, _
Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20")
End If
End If
If Muoi <> 0 And DonVi = 5 Then
BangChu = BangChu + ";6C;103;6D;20" + Ten + ";20"
Else
If Muoi > 1 And DonVi = 1 Then
BangChu = BangChu + ";6D;1ED1;74;20" + Ten + ";20"
Else
BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten) + ";20"
End If
End If
Else
BangChu = BangChu + IIf(I = 4, DonViTien + "", "")
End If
I = I + 1
Wend
If Right(BangChu, 3) = ";20" Then
BangChu = Left(BangChu, Len(BangChu) - 3)
End If
BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";2e;20")
If SoLe = 0 Then
BangChu = BangChu + IIf(Right(BangChu, 3) = 0, "", ";20")
End If
BangChu = UnicodeChar(BangChu)
'?o^?i sang tie^'ng Vie^.t Unicode
' ?o^?i chu+~ ci ?a^`u tin thnh chu+~ hoa
Mid$(BangChu, 1, 1) = UCase$(Mid$(BangChu, 1, 1))
SoRaChu = BangChu
End Function
Bạn chép đoạn Code dưới vào Module trong cửa sổ VBA
nhập công thức =sorachu(A1) với A1 là ô chứa số , chọn fonts Times New Roman


Function UnicodeChar(UniCharCode As String) As String
On Error GoTo Loi
Dim str
Dim desStr As String
Dim I
If Mid(UniCharCode, 1, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 2)
End If
If Right(UniCharCode, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 1, Len(UniCharCode) - 1)
End If
str = UniCharCode
str = Split(str, ";")
For I = LBound(str) To UBound(str)
desStr = desStr & ChrW$("&H" & str(I))
Next
UnicodeChar = desStr
Loi:
Exit Function
End Function
Function SoRaChu(ByVal NumCurrency As Currency) As String
Static CharVND(9) As String, BangChu As String, I As Integer
Dim SoLe, SoDoi As Integer, PhanChan, Ten As String
Dim DonViTien As String, DonViLe As String
Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer
Dim Dong As Integer, Tram As Integer, Muoi As Integer, DonVi As Integer
DonViTien = ";111;1ED3;6E;67" ' ?o^`ng
DonViLe = ";78;75" ' xu
If NumCurrency = 0 Then
SoRaChu = UnicodeChar(";4B;68;F4;6E;67;20" & DonViTien)
Exit Function
End If
If NumCurrency > 922337203685477# Then ' So^' lo+'n nha^'t cu?a loa.i CURRENCY
SoRaChu = UnicodeChar(";4B;68;F4;6E;67;20;111;1ED5;69;20;111;1B0;1EE3;63;20;73" & _
";1ED1;20;6C;1EDB;6E;20;68;1A1;6E;20;39;32;32;2C;33;33;37" & _
";2C;32;30;33;2C;36;38;35;2C;34;37;37")
Exit Function
End If
CharVND(1) = ";6D;1ED9;74" ' mo^.t
CharVND(2) = ";68;61;69" ' hai
CharVND(3) = ";62;61" ' ba
CharVND(4) = ";62;1ED1;6E" ' bo^'n
CharVND(5) = ";6E;103;6D" ' na(m
CharVND(6) = ";73;E1;75" ' su
CharVND(7) = ";62;1EA3;79" ' ba?y
CharVND(8) = ";74;E1;6D" ' tm
CharVND(9) = ";63;68;ED;6E" ' chn
CharVND(0) = ";78;75"
SoLe = Int((NumCurrency - Int(NumCurrency)) * 100) ' 2 k so^'
PhanChan = Trim$(str$(Int(NumCurrency)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan
NganTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Ngan = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
If NganTy = 0 And Ty = 0 And Trieu = 0 And Ngan = 0 And Dong = 0 Then
BangChu = ";6B;68;F4;6E;67;20" + DonViTien + ";20"
I = 5
Else
BangChu = ""
I = 0
End If
'-----------------------------------------------------
' Ba('t ?a^`u ?o^?i
'-----------------------------------------------------
While I <= 5
Select Case I
Case 0
SoDoi = NganTy
Ten = ";6E;67;68;EC;6E;20;74;1EF7" 'ngh×n ty?
Case 1
SoDoi = Ty
Ten = ";74;1EF7" ' ty?
Case 2
SoDoi = Trieu
Ten = ";74;72;69;1EC7;75" ' trie^.u
Case 3
SoDoi = Ngan
Ten = ";6E;67;68;EC;6E" 'ngh×n
Case 4
SoDoi = Dong
Ten = DonViTien ' ?o^`ng
Case 5
SoDoi = SoLe
Ten = DonViLe ' xu
End Select
If SoDoi <> 0 Then
Tram = Int(SoDoi / 100)
Muoi = Int((SoDoi - Tram * 100) / 10)
DonVi = (SoDoi - Tram * 100) - Muoi * 10
If Right(BangChu, 3) = ";20" Then
BangChu = Left(BangChu, Len(BangChu) - 3)
End If
BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";2C;20") + _
IIf(Tram <> 0, Trim(CharVND(Tram)) + ";20;74;72;103;6D;20", "")
If Muoi = 0 And Tram <> 0 And DonVi <> 0 Then
BangChu = BangChu + ";6C;1EBB;20"
Else
If Muoi <> 0 Then
BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, _
Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20")
End If
End If
If Muoi <> 0 And DonVi = 5 Then
BangChu = BangChu + ";6C;103;6D;20" + Ten + ";20"
Else
If Muoi > 1 And DonVi = 1 Then
BangChu = BangChu + ";6D;1ED1;74;20" + Ten + ";20"
Else
BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten) + ";20"
End If
End If
Else
BangChu = BangChu + IIf(I = 4, DonViTien + "", "")
End If
I = I + 1
Wend
If Right(BangChu, 3) = ";20" Then
BangChu = Left(BangChu, Len(BangChu) - 3)
End If
BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";2e;20")
If SoLe = 0 Then
BangChu = BangChu + IIf(Right(BangChu, 3) = 0, "", ";20")
End If
BangChu = UnicodeChar(BangChu)
'?o^?i sang tie^'ng Vie^.t Unicode
' ?o^?i chu+~ ci ?a^`u tin thnh chu+~ hoa
Mid$(BangChu, 1, 1) = UCase$(Mid$(BangChu, 1, 1))
SoRaChu = BangChu
End Function
bác cho em hỏi muốn thêm dòng chữ: "Tổng số tiền ghi bằng chữ:" thì làm thế nào ạ
 
Web KT
Back
Top Bottom