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

Liên hệ QC

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
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!
Đâ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
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!

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
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! -+*/

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
Web KT

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

Back
Top Bottom