Chuyển số thành chữ trong excel - vấn đề cần giúp đỡ!

Liên hệ QC
baobaoqaz

baobaoqaz

Thành viên mới
Tham gia
26/10/12
Bài viết
3
Được thích
1
Chào cả nhà!

1 Em đã tìm trên diễn đàn cuối cung được file xla này:
(theo file đính kèm "Ham UniVND - ok.xls")

Nhưng vấn đề là khi em chạy lệnh:
=univnd(125)
Thì kết quả tương ứng là: "Một trăm hai mươi năm"
Kết quả mong muốn của em là: "Một trăm hai mươi lăm"

Em thật tình không biết viết lệnh và sữa lệnh bên VBA này như thế nào? Mong các anh Chị giúp đở!

2 Nếu các anh chị có file Đỗi số thành chữ có các điều kiện như sau thì share cho em với em đang rất cần...Chân thành cám ơn!

- 125.159.000
Chuyễn sang chữ là " Một trăm hai mươi lăm triệu, một trăm năm mươi chín ngàn"

+ Hoa đầu câu
+ Có dấu phẩy giửa hàng tỷ, triệu, trăm, ngàn
+ Không có thành tố phụ phía sau như "đồng", "đồng chẵn", "xu"

Chân thành cám ơn!
 

File đính kèm

  • Ham UniVND - ok.xls
    45 KB · Đọc: 44
Sắp xếp theo thời gian sắp xếp theo bầu chọn
baobaoqaz đã viết:
Chào cả nhà!

1 Em đã tìm trên diễn đàn cuối cung được file xla này:
(theo file đính kèm "Ham UniVND - ok.xls")

Nhưng vấn đề là khi em chạy lệnh:
=univnd(125)
Thì kết quả tương ứng là: "Một trăm hai mươi năm"
Kết quả mong muốn của em là: "Một trăm hai mươi lăm"

Em thật tình không biết viết lệnh và sữa lệnh bên VBA này như thế nào? Mong các anh Chị giúp đở!

2 Nếu các anh chị có file Đỗi số thành chữ có các điều kiện như sau thì share cho em với em đang rất cần...Chân thành cám ơn!

- 125.159.000
Chuyễn sang chữ là " Một trăm hai mươi lăm triệu, một trăm năm mươi chín ngàn"

+ Hoa đầu câu
+ Có dấu phẩy giửa hàng tỷ, triệu, trăm, ngàn
+ Không có thành tố phụ phía sau như "đồng", "đồng chẵn", "xu"

Chân thành cám ơn!
Nhấp chuột vào đây để mở rộng...
Đây là code đọc số của bạn huuthang_bd, có thể đáp ứng được nhu cầu của bạn:
Mã: 
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
  Dim i As Long
  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
Hàm đọc cả 3 bảng mã. Cú pháp
=DocSo(Số, 1): Hiện thị kết quả theo mã Unicode
=DocSo(Số, 2): Hiện thị kết quả theo mã VNI-Windows
=DocSo(Số, 3): Hiện thị kết quả theo mã TCVN3
---------------------------
Theo nhận xét của tôi thì code này ngắn gọn (hơn những hàm trên GPE từ trước đến giờ) và khá chuẩn
 

File đính kèm

  • DocSo.xls
    43.5 KB · Đọc: 51
Upvote 0
Cám ơn ndu file Anh gởi đáp ứng hết các yêu cầu em cần, nhưng còn một vấn đề nhỏ như sau, nhờ anh giải quyết dùm em luôn, để em có 1 file hoàn chĩnh!

=DocSo(123456, 1) --> "Một trăm hai mươi ba ngàn, bốn trăm năm mươi sáu."

- Bị dính dấu chấm - anh chỉ dùm em cách bỏ dấu chấm! - Cám ơn Anh

Vì xuất dữ liệu ra của em có khi thêm vào dãy số chữ "đồng" hoặc "đơn vị".

- Khi em thêm vào lênh =DocSo(123456, 1)&" đồng"

Nếu có dấu chấm vào sẽ thành ra "Một trăm hai mươi ba ngàn, bốn trăm năm mươi sáu. đồng"

Anh giúp dùm....Thân!
 
Lần chỉnh sửa cuối:
Upvote 0
baobaoqaz đã viết:
Cám ơn ndu file Anh gởi đáp ứng hết các yêu cầu em cần, nhưng còn một vấn đề nhỏ như sau, nhờ anh giải quyết dùm em luôn, để em có 1 file hoàn chĩnh!

=DocSo(123456, 1) --> "Một trăm hai mươi ba ngàn, bốn trăm năm mươi sáu."

- Bị dính dấu chấm - anh chỉ dùm em cách bỏ dấu chấm! - Cám ơn Anh

Vì xuất dữ liệu ra của em có khi thêm vào dãy số chữ "đồng" hoặc "đơn vị".

- Khi em thêm vào lênh =DocSo(123456, 1)&" đồng"

Nếu có dấu chấm vào sẽ thành ra "Một trăm hai mươi ba ngàn, bốn trăm năm mươi sáu. đồng"

Anh giúp dùm....Thân!
Nhấp chuột vào đây để mở rộng...

Tôi đồng ý với bạn điều này: rằng UDF đọc số không nên thêm "đồng", "USD", "VND" hay dấu chấm cuối câu gì cả. Người dùng thích sao, họ sẽ tự thêm
Để bỏ dấu chấm, bạn sửa đoạn code cuối cùng:
Mã: 
DocSo = Replace(UCase(Left(DocSo, 1)) & Mid(DocSo, 2) & ".", ",.", ".")
Thành:
Mã: 
DocSo = UCase(Left(DocSo, 1)) & Mid(DocSo, 2)
 
Upvote 0
Anh ơi!

- Em đã chuyển code như Anh chỉ, thành công với file của Đính kèm của anh còn với file của em thì lỗi như thế này (anh xem file đính kèm dùm em nhé) - Bị dấu phẩy ... Anh chỉ dùm em cách khắc phục!

- Em mò vụ này mấy ngày nay mà không xong! -+*/
 

File đính kèm

  • TO TRINH GNN.xls
    49.5 KB · Đọc: 11
Lần chỉnh sửa cuối:
Upvote 0
baobaoqaz đã viết:
Anh ơi!

- Em đã chuyển code như Anh chỉ, thành công với file của Đính kèm của anh còn với file của em thì lỗi như thế này (anh xem file đính kèm dùm em nhé) - Bị dấu phẩy ... Anh chỉ dùm em cách khắc phục!

- Em mò vụ này mấy ngày nay mà không xong! -+*/
Nhấp chuột vào đây để mở rộng...

Vừa định nói thì bạn đã phát hiện ra... Ẹc... Ẹc...
Thêm dòng lệnh này vào dưới cùng nhé:
Mã: 
If Right(DocSo, 1) = "," Then DocSo = Mid(DocSo, 1, Len(DocSo) - 1)
Đồng thời sửa đoạn này:
Mã: 
If Str = "000000000000000000" Then
  DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) [COLOR=#ff0000]& "."[/COLOR]
  Exit Function
End If
Thành:
Mã: 
If Str = "000000000000000000" Then
  DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2)) 
  Exit Function
End If
Toàn bộ code sửa lại:
Mã: 
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
 [COLOR=#ff0000] If Str = "000000000000000000" Then
    DocSo = UCase(Left(MyArray(0), 1)) & Trim(Mid(MyArray(0), 2))
    Exit Function
  End If[/COLOR]
  Dim i As Long
  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
  [COLOR=#ff0000]Mid(DocSo, 1, 1) = UCase(Mid(DocSo, 1, 1))
  If Right(DocSo, 1) = "," Then DocSo = Mid(DocSo, 1, Len(DocSo) - 1)[/COLOR]
End Function


-----------------------------------------
(Tôi cứ nghĩ rằng bạn tự nghiên cứu được)
 
Lần chỉnh sửa cuối:
Upvote 0
tesst
Rich (BB code): 
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
  Dim i As Long
  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
  Mid(DocSo, 1, 1) = UCase(Mid(DocSo, 1, 1))
  If Right(DocSo, 1) = "," Then DocSo = Mid(DocSo, 1, Len(DocSo) - 1)
End Function
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

son0611excel
  • Question
VBA tra cứu hình theo điều kiện
Trả lời
11
Đọc
217
tle2003
T
Salem999999999
Lọc dữ liệu có điều kiện
2
Trả lời
25
Đọc
541
tle2003
T
vuongnlks
Lấy dữ liệu 1 cột cụ thể theo ngày từ nhiều file CSV ứng với mã tương ứng trong cột MA CO PHIEU
Trả lời
1
Đọc
77
BuiQuangThuan
B
V
Hỗ trợ hàm Sumproduct và Subtotal trong GG Sheets
Trả lời
3
Đọc
230
nguyenngocphuongsw
nguyenngocphuongsw
K
Tính tổng có điều kiện
Trả lời
4
Đọc
159
kimson_nb
K
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