Làm gì có chuyện có gõ số ở 1 ô Enter mà lại ra chữ ở ô khácEm 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"
Bạn chép đoạn Code dưới vào Module trong cửa sổ VBAThì ý mình muốn viết công thức hàm nào để có thể hiện ra chữ
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
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.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 ạ..![]()
Hàm là =sorachu() đó cô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 ạ..![]()
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"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
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. hiiiEm 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???
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.
Anh này khéo nói đùa ghê, lão tổ về code mà khiêm tốn thế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.
,Biết áp dụng là mừng rồi. Anh cũng như em thôi.
nhưng thừa nhận code này nhìn vô phê quá. có cách ngăn hơn ko????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.
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
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 ạ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
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 đó.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 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 ạ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
Công thức tại cell nào đó bạn định đặtbá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 ạ
"Tổng số tiền ghi bằng chữ: "&SoRaChu(A1)