Xin CODE đổi số thành chữ

Liên hệ QC
Status
Không mở trả lời sau này.
Cá ngừ F1

Cá ngừ F1

( ͡° ͜ʖ ͡°)
Thành viên BQT
Moderator
Tham gia
1/1/08
Bài viết
2,579
Được thích
3,715
Donate (Momo)
Donate
Giới tính
Nam
Nghề nghiệp
Quan hệ.. và quan hệ..
Các addin đổi số thành chữ trên GPE rất hay, nhưng có một vấn đề là file của e nhiều người cùng sử dụng 1 lúc, trong khi máy này cài addin, máy kia lại ko cài => đọc các hàm bị lỗi.

Do vậy, Anh chị trên GPE có thể cho e xin đoạn code VBA đổi số ra chữ được ko ạh, để em nhúng trực tiếp vào file Excel để bất kỳ máy trạm nào mở cũng có thể đọc được hàm.

many tks !!!
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Cá ngừ F1 đã viết:
Các addin đổi số thành chữ trên GPE rất hay, nhưng có một vấn đề là file của e nhiều người cùng sử dụng 1 lúc, trong khi máy này cài addin, máy kia lại ko cài => đọc các hàm bị lỗi.

Do vậy, Anh chị trên GPE có thể cho e xin đoạn code VBA đổi số ra chữ được ko ạh, để em nhúng trực tiếp vào file Excel để bất kỳ máy trạm nào mở cũng có thể đọc được hàm.

many tks !!!
Nhấp chuột vào đây để mở rộng...
Đa phần các add-in này là mã nguồn mở. Bạn tải Add-in về rồi vào đó mà lấy. Có khó khăn gì đâu chứ.

Đây là code của tôi
PHP: 
'huuthang_bd - giaiphapexcel.com
Function DocSo(ByVal Number, Optional ByVal Font = 1) As String
Dim MyArray
Dim Str
Str = Format(Abs(Number), "000000000000000000")
Select Case Font
Case 1
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ")
Case 2
MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")
Case 3
MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m­¬i ", "kh«ng m­¬i kh«ng ", "kh«ng m­¬i", "lÎ", "m­¬i kh«ng", "m­¬i", "m­¬i n¨m", "m­¬i l¨m", "mét m­¬i", "m­êi", "m­¬i mét", "m­¬i mèt", "©m ")
End Select
If Str = "000000000000000000" Then
    DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) & "."
    Exit Function
End If
For i = 1 To Len(Str)
If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
    DocSo = DocSo & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))
ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
    DocSo = DocSo & MyArray(12)
End If
Next
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))
If Number < 0 Then
DocSo = MyArray(29) & DocSo
End If
DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", ".")
End Function
Cú pháp:
Mã: 
=DocSo(Number,Font)
Number là số cần đọc
Font dùng để chọn bảng mã của chuỗi kết quả. 1 = Unicode, 2 = VNI Windows, 3 = TCVN3. Nếu bỏ qua tham số này thì mặc định là Unicode.
 
Upvote 0
huuthang_bd đã viết:
Đa phần các add-in này là mã nguồn mở. Bạn tải Add-in về rồi vào đó mà lấy. Có khó khăn gì đâu chứ.

Đây là code của tôi
PHP: 
'huuthang_bd - giaiphapexcel.com
Function DocSo(ByVal Number, Optional ByVal Font = 1) As String
Dim MyArray
Dim Str
Str = Format(Abs(Number), "000000000000000000")
Select Case Font
Case 1
MyArray = Array("không ", "m" & ChrW(7897) & "t ", "hai ", "ba ", "b" & ChrW(7889) & "n ", "n" & ChrW(259) & "m ", "sáu ", "b" & ChrW(7843) & "y ", "tám ", "chín ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "t" & ChrW(7927) & ", ", "tri" & ChrW(7879) & "u, ", "ngàn, ", "", "tr" & ChrW(259) & "m ", "m" & ChrW(432) & ChrW(417) & "i ", "không " & "m" & ChrW(432) & ChrW(417) & "i" & " không ", "không " & "m" & ChrW(432) & ChrW(417) & "i", "l" & ChrW(7867), "m" & ChrW(432) & ChrW(417) & "i" & " không", "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " n" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(417) & "i" & " l" & ChrW(259) & "m", "m" & ChrW(7897) & "t " & "m" & ChrW(432) & ChrW(417) & "i", "m" & ChrW(432) & ChrW(7901) & "i", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7897) & "t", "m" & ChrW(432) & ChrW(417) & "i" & " m" & ChrW(7889) & "t", "Âm ")
Case 2
MyArray = Array("khoâng ", "moät ", "hai ", "ba ", "boán ", "naêm ", "saùu ", "baûy ", "taùm ", "chín ", "trieäu, ", "ngaøn, ", "tyû, ", "trieäu, ", "ngaøn, ", "", "traêm ", "möôi ", "khoâng möôi khoâng ", "khoâng möôi", "leû", "möôi khoâng", "möôi", "möôi naêm", "möôi laêm", "moät möôi", "möôøi", "möôi moät", "möôi moát", "AÂm ")
Case 3
MyArray = Array("kh«ng ", "mét ", "hai ", "ba ", "bèn ", "n¨m ", "s¸u ", "b¶y ", "t¸m ", "chÝn ", "triÖu, ", "ngµn, ", "tû, ", "triÖu, ", "ngµn, ", "", "tr¨m ", "m­¬i ", "kh«ng m­¬i kh«ng ", "kh«ng m­¬i", "lÎ", "m­¬i kh«ng", "m­¬i", "m­¬i n¨m", "m­¬i l¨m", "mét m­¬i", "m­êi", "m­¬i mét", "m­¬i mèt", "©m ")
End Select
If Str = "000000000000000000" Then
    DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) & "."
    Exit Function
End If
For i = 1 To Len(Str)
If Left(Str, i) <> 0 And Mid(Str, (Int((i + 2) / 3) - 1) * 3 + 1, 3) <> 0 Then
    DocSo = DocSo & MyArray(Mid(Str, i, 1)) & MyArray(-(9 + i / 3) * (i Mod 3 = 0) - (15 + i Mod 3) * (i Mod 3 <> 0))
ElseIf i = 9 And Mid(Str, 7, 3) = 0 And Left(Str, 6) <> 0 Then
    DocSo = DocSo & MyArray(12)
End If
Next
DocSo = Trim(Replace(Replace(Replace(Replace(Replace(Replace(DocSo, MyArray(18), MyArray(15)), MyArray(19), MyArray(20)), MyArray(21), MyArray(22)), MyArray(23), MyArray(24)), MyArray(25), MyArray(26)), MyArray(27), MyArray(28)))
If Number < 0 Then
DocSo = MyArray(29) & DocSo
End If
DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", ".")
End Function
Cú pháp:
Mã: 
=DocSo(Number,Font)
Number là số cần đọc
Font dùng để chọn bảng mã của chuỗi kết quả. 1 = Unicode, 2 = VNI Windows, 3 = TCVN3. Nếu bỏ qua tham số này thì mặc định là Unicode.
Nhấp chuột vào đây để mở rộng...
Mình copy trực tiếp code của bạn vào, sao ko được vậy nhỉ?
P/S: mình chưa biết j về lập trình cả..hì
 

File đính kèm

  • Book1.xlsm
    14.7 KB · Đọc: 451
Upvote 0
Status
Không mở trả lời sau này.
Web KT

Bài viết mới nhất

N
Code xếp loại theo nhiều điều kiện (điền kiện "động" không cố định)
Trả lời
13
Đọc
160
Hoàng Tuấn 868
H
Thịnh Nguyễn 2
Mọi người giúp e câu 3 và 4 với ạ . E mới học nên ko bt sử dụng ạ
Trả lời
5
Đọc
77
VetMini
V
hongphuong1997
Đếm ô có dữ liệu.
    • Chấp nhận
    • Thích
Trả lời
15
Đọc
331
VetMini
V
C
Sai số trong công thức
Trả lời
2
Đọc
61
VetMini
V
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
2
Trả lời
36
Đọc
784
Emyeuexcel
Emyeuexcel
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom