Số tiền bằng chữ? (2 người xem)

  • Thread starter Thread starter HaThuy
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
gaconlongvang đã viết:
Tôi up AddIns “Đổi số ra chữ” này lên để ai có mục đích sử dụng như tôi thì down về dùng.
Xin nói trước là AddIns này tôi down trên diễn đàn và đã chỉnh sửa lại. Xin lỗi tác giả AddIns này. Lý do tôi chỉnh sửa là:
Khi đổi: 12,345.65 = Mười hai ngàn, ba trăm bốn nhăm đồng sáu nhăm
Tôi sửa AddIns này để khi đổi:
12,345.65 => =vnd(…)=Mười hai ngàn, ba trăm bốn sáu đồng chẵn
Cách sử dụng:
Copy AddIn theo đường dẫn: C:\Documents and Settings\Administrator\Application Data\Microsoft\AddIns
Khởi động Ecxel, vào Tool\Add-Ins\Browse… Chỉ theo đường dẫn trên đến AddIns “vnd”\OK.
Khởi động lại Ecxel.
AddIns này sử dụng font Unicode
Hy vọng có ích cho mọi người.
Nhấp chuột vào đây để mở rộng...
Mình đã dùng thử add-in của bạn nhưng khi thử kết quả:
12,345.65 = Mười hai ngàn, ba trăm bốn mươi lăm đồng, sáu mươi lăm xu
bạn có thể sửa giúp lỗi đó không?
 
Tốt nhất bạn mở VBA =Alt+f11 tạo modun và dán vào đoạn code sau:"mình sử dụng Vntime nha VD: muốn đọc số ô A1 bạn chỉ cần gõ =bac(A1)
PHP: 
Function bac(A) As String
Dim s, cdv, ctr, cng, cty As String
    Dim sdv, strieu, sng, sty As String
    chuoi = ""
    s = Trim(Str(A))
    While Len(s) < 12
        s = "0" + s
    Wend
    sdv = Right(s, 3)
    sng = Mid(s, 7, 3)
    strieu = Mid(s, 4, 3)
    sty = Left(s, 3)
    chuoi = IIf(doi(sty) <> " ", doi(sty) & " t?", "") & IIf(doi(strieu) <> " ", doi(strieu) & " triÖu", "") & IIf(doi(sng) <> " ", doi(sng) & " ngµn", "") & IIf(doi(sdv) <> " ", doi(sdv), "") & " ®ång ch½n"
    bac = UCase(Left(Trim(chuoi), 1)) & Right(Trim(chuoi), Len(Trim(chuoi)) - 1) & "."
End Function
Function doi(c) As String
    Dim dv, ch, tr, st1 As String
    While Len(c) < 3
        c = "0" & Trim(c)
    Wend
    dv = Right(c, 1)
    ch = Mid(c, 2, 1)
    tr = Left(c, 1)
    st1 = ""
    If tr = "0" Then
        If ch = "0" Then
            If dv = "0" Then
                st1 = st1 & " "
            Else
                st1 = st1 & so(dv)
            End If
        Else
            If dv = "0" Then
                st1 = st1 & IIf(ch = "1", " m­êi", so(ch) & "  m­¬i")
            Else
                st1 = st1 & IIf(ch = "1", " m­êi", so(ch) & "  m­¬i") & IIf(dv = "1", " mèt", IIf(dv = "5", " n¨m", so(dv)))
            End If
        End If
    Else
        If ch = "0" Then
            If dv = "0" Then
                st1 = st1 & so(tr) & " tr¨m"
            Else
                st1 = st1 & so(tr) & " tr¨m linh" & so(dv)
            End If
        Else
            If dv = "0" Then
                st1 = st1 & so(tr) & " tr¨m" & IIf(ch = "1", " m­êi", so(ch) & " m­¬i")
            Else
                st1 = st1 & so(tr) & " tr¨m" & IIf(ch = "1", " m­êi", so(ch) & " m­¬i") & IIf(dv = "1", IIf(ch = "1", " mèt", " mèt"), IIf(dv = "5", " n¨m", so(dv)))
            End If
        End If
    End If
    doi = st1
End Function
Function so(c) As String
    s = ""
Select Case c
        Case "0"
            s = s + " kh«ng"
        Case "1"
            s = s + " mét"
        Case "2"
            s = s + " hai"
        Case "3"
            s = s + " ba"
        Case "4"
            s = s + " bèn"
        Case "5"
            s = s + " n¨m"
        Case "6"
            s = s + " s¸u"
        Case "7"
            s = s + " b¶y"
        Case "8"
            s = s + " t¸m"
        Case "9"
            s = s + " chÝn"
    End Select
    so = s
End Function
 
Chỉnh sửa lần cuối bởi điều hành viên:
hoangle17 đã viết:
Tốt nhất bạn mở VBA =Alt+f11 tạo modun và dán vào đoạn code sau:"mình sử dụng Vntime nha VD: muốn đọc số ô A1 bạn chỉ cần gõ =bac(A1)
PHP: 
Function bac(A) As String
Dim s, cdv, ctr, cng, cty As String
    Dim sdv, strieu, sng, sty As String
    chuoi = ""
    s = Trim(Str(A))
    While Len(s) < 12
        s = "0" + s
    Wend
    sdv = Right(s, 3)
    sng = Mid(s, 7, 3)
    strieu = Mid(s, 4, 3)
    sty = Left(s, 3)
    chuoi = IIf(doi(sty) <> " ", doi(sty) & " t?", "") & IIf(doi(strieu) <> " ", doi(strieu) & " triÖu", "") & IIf(doi(sng) <> " ", doi(sng) & " ngµn", "") & IIf(doi(sdv) <> " ", doi(sdv), "") & " ®ång ch½n"
    bac = UCase(Left(Trim(chuoi), 1)) & Right(Trim(chuoi), Len(Trim(chuoi)) - 1) & "."
End Function
Function doi(c) As String
    Dim dv, ch, tr, st1 As String
    While Len(c) < 3
        c = "0" & Trim(c)
    Wend
    dv = Right(c, 1)
    ch = Mid(c, 2, 1)
    tr = Left(c, 1)
    st1 = ""
    If tr = "0" Then
        If ch = "0" Then
            If dv = "0" Then
                st1 = st1 & " "
            Else
                st1 = st1 & so(dv)
            End If
        Else
            If dv = "0" Then
                st1 = st1 & IIf(ch = "1", " m­êi", so(ch) & "  m­¬i")
            Else
                st1 = st1 & IIf(ch = "1", " m­êi", so(ch) & "  m­¬i") & IIf(dv = "1", " mèt", IIf(dv = "5", " n¨m", so(dv)))
            End If
        End If
    Else
        If ch = "0" Then
            If dv = "0" Then
                st1 = st1 & so(tr) & " tr¨m"
            Else
                st1 = st1 & so(tr) & " tr¨m linh" & so(dv)
            End If
        Else
            If dv = "0" Then
                st1 = st1 & so(tr) & " tr¨m" & IIf(ch = "1", " m­êi", so(ch) & " m­¬i")
            Else
                st1 = st1 & so(tr) & " tr¨m" & IIf(ch = "1", " m­êi", so(ch) & " m­¬i") & IIf(dv = "1", IIf(ch = "1", " mèt", " mèt"), IIf(dv = "5", " n¨m", so(dv)))
            End If
        End If
    End If
    doi = st1
End Function
Function so(c) As String
    s = ""
Select Case c
        Case "0"
            s = s + " kh«ng"
        Case "1"
            s = s + " mét"
        Case "2"
            s = s + " hai"
        Case "3"
            s = s + " ba"
        Case "4"
            s = s + " bèn"
        Case "5"
            s = s + " n¨m"
        Case "6"
            s = s + " s¸u"
        Case "7"
            s = s + " b¶y"
        Case "8"
            s = s + " t¸m"
        Case "9"
            s = s + " chÝn"
    End Select
    so = s
End Function
Nhấp chuột vào đây để mở rộng...

Minh đã làm theo code của bạn hoàn toàn hiệu nghiệm. Nhưng cho mình hỏi mình muốn có dấu phẩy ở hàng ngàn, triệu... thì viết lại code này thế nào nhỉ? vd: 1.234 = một ngàn, hai trăm ba mươi bốn ngàn đồng. Tại khi viết hóa đơn, chứng từ mình sd dấu phẩy quen rồi.
Cảm ơn bạn nhiều!
 
nguyenbbc đã viết:
Minh đã làm theo code của bạn hoàn toàn hiệu nghiệm. Nhưng cho mình hỏi mình muốn có dấu phẩy ở hàng ngàn, triệu... thì viết lại code này thế nào nhỉ? vd: 1.234 = một ngàn, hai trăm ba mươi bốn ngàn đồng. Tại khi viết hóa đơn, chứng từ mình sd dấu phẩy quen rồi.
Cảm ơn bạn nhiều!
Nhấp chuột vào đây để mở rộng...

Bạn kiểm tra lại nha. Mình đã test code thửa của bạn và vẫn thấy lỗi.
01200.jpg
 
NH_DK đã viết:
Bạn kiểm tra lại nha. Mình đã test code thửa của bạn và vẫn thấy lỗi.
01200.jpg
Nhấp chuột vào đây để mở rộng...
đây là code trên diễn đàn sử dụng font vni nè
PHP: 
Public Function VND(BaoNhieu)
    Dim KetQua, SoTien, Nhom, Chu, Dich, S1, S2, S3 As String
    Dim i, j, ViTri As Byte, S As Double
    Dim Hang, Doc, Dem
    If BaoNhieu = 0 Then
        KetQua = "Khoâng ñoàng"
    Else
        If Abs(BaoNhieu) >= 1E+15 Then '1E+15 töùc 1.000.000.000.000.000 1 trieäu tyû
            KetQua = "Soá quaù lôùn"
        Else
            If BaoNhieu < 0 Then
                KetQua = "Tröø" & Space(1)
            Else
                KetQua = Space(0)
            End If
            SoTien = Format(Abs(BaoNhieu), "##############0.00") '18 digits with 2 decimal
            SoTien = Right(Space(15) & SoTien, 18)
            Hang = Array("None", "traêm", "möôi", "gì ñoù")
            Doc = Array("None", "ngaøn tyû", "tyû", "trieäu", "ngaøn", "ñoàng", "xu")
            Dem = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
            For i = 1 To 6
                Nhom = Mid(SoTien, i * 3 - 2, 3)
                If Nhom <> Space(3) Then
                    Select Case Nhom
                        Case "000"
                            If i = 5 Then
                                Chu = "ñoàng" & Space(1)
                            Else
                                Chu = Space(0)
                            End If
                        Case ".00", ",00"
                            Chu = "chaün"
                        Case Else
                            S1 = Left(Nhom, 1)
                            S2 = Mid(Nhom, 2, 1)
                            S3 = Right(Nhom, 1)
                            Chu = Space(0)
                            Hang(3) = Doc(i)
                            For j = 1 To 3
                                Dich = Space(0)
                                S = Val(Mid(Nhom, j, 1))
                                If S > 0 Then
                                    Dich = Dem(S) & Space(1) & Hang(j) & Space(1)
                                End If
                                Select Case j
                                    Case 2 And S = 1
                                        Dich = "möôøi" & Space(1)
                                    Case 3 And S = 0 And Nhom <> Space(2) & "0"
                                        Dich = Hang(j) & Space(1)
                                    Case 3 And S = 5 And S2 <> Space(1) And S2 <> "0"
                                          Dich = "l" & Mid(Dich, 2)
                                    Case 2 And S = 0 And S3 <> "0"
                                        If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And i = 4) Then
                                            Dich = "leû" & Space(1)
                                        End If
                                End Select
                                Chu = Chu & Dich
                            Next j
                        End Select
                        ViTri = InStr(1, Chu, "möôi moät", 1)
                        If ViTri > 0 Then Mid(Chu, ViTri, 9) = "möôi moát"
                        KetQua = KetQua & Chu
                    End If
            Next i
        End If
    End If
    VND = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
 
Ban oi minh dang dung phien ban exel 2007, ban chi cho minh cach cai add-in nha
 
Cảm ơn bạn nhiều, nhưng mình cần sử dụng Unicode nhiều hơn!
 
Đây là Font Unicode, mở VBA bạn chép hàm UDF này vào là được. Trong bảng tính ô A1 là số tại ô bằng chữ gõ công thức:

=DocsoUNI(A1)

Mã: 
Public Function DocsoUNI(tienvao)
Dim ketqua, sotien, nhom, chu, dich, s1, s2, s3 As String
Dim i, j, vitri As Byte, s As Double
Dim hang, doc, dem
tienvao = Int(tienvao)
If tienvao = 0 Then
ketqua = "Kh" & ChrW(244) & "ng " & ChrW(273) & ChrW(7891) & "ng."
Else
If Abs(tienvao) >= 1E+15 Then
ketqua = "S" & ChrW(7889) & " qu" & ChrW(225) & " l" & ChrW(7899) & "n."
Else
If tienvao <= 0 Then
ketqua = "Tr" & ChrW(7915) & Space(1)
Else
ketqua = Space(0)
End If
sotien = Abs(tienvao)
sotien = Right(Space(15) & sotien, 15)
hang = Array("none", "tr" & ChrW(259) & "m", "m" _
& ChrW(432) & ChrW(417) & "i", "kh" & ChrW(225) & "c")
doc = Array("none", "ng" & ChrW(224) & "n t" & ChrW(7927), "t" & ChrW(7927), _
"tri" & ChrW(7879) & "u", "ng" & ChrW(224) & "n", ChrW(273) & ChrW(7891) & "ng.")
dem = Array("none", "m" & ChrW(7897) & "t", "hai", "ba", "b" & ChrW(7889) & "n", _
"n" & ChrW(259) & "m", "s" & ChrW(225) & "u", "b" & ChrW(7843) _
& "y", "t" & ChrW(225) & "m", "ch" & ChrW(237) & "n")
For i = 1 To 5
nhom = Mid(sotien, i * 3 - 2, 3)
If nhom <> Space(3) Then
Select Case nhom
Case "000"
If i = 5 Then
chu = ChrW(273) & ChrW(7891) & "ng ch" & ChrW(7861) & "n" & Space(1)
Else
chu = Space(0)
End If
Case Else
s1 = Left(nhom, 1)
s2 = Mid(nhom, 2, 1)
s3 = Right(nhom, 1)
chu = Space(0)
hang(3) = doc(i)
For j = 1 To 3
dich = Space(0)
s = Val(Mid(nhom, j, 1))
If s > 0 Then
dich = dem(s) & Space(1) & hang(j) & Space(1)
End If
Select Case j
Case 2 And s = 1
dich = "m" & ChrW(432) & ChrW(417) & "i" & Space(1)
Case 3 And s = 0 And nhom <> Space(2) & "0"
dich = hang(j) & Space(1)
Case 3 And s = 5 And s2 <> Space(1) And s2 <> "0"
dich = "l" & Mid(dich, 2)
Case 2 And s = 0 And s3 <> "0"
If (s1 >= "1" And s1 <= "9") Or (s1 = "0" And i = 4) Then
dich = "l" & ChrW(7867) & Space(1)
End If
End Select
chu = chu & dich
Next j
End Select
vitri = InStr(1, chu, "m" & ChrW(432) & ChrW(417) & "i m" & ChrW(7897) & "t", 1)
If vitri > 0 Then Mid(chu, vitri, 9) = "m" & ChrW(432) & ChrW(417) & "i m" & ChrW(7889) & "t"
ketqua = ketqua & chu
End If
Next i
End If
End If
DocsoUNI = UCase(Left(ketqua, 1)) & Mid(ketqua, 2)
End Function
 
Jenni đã viết:


Bạn down add-in sau về,giải nén.Copy file vừa giải nén,sau đó vào tool/add-ins chọn browse===>paste===>click double vào add-ins đó===>click ok.

Vd: ở ô A1: 12.500.000đ

Ở ô A2 bạn gõ: =vnd(A1)

Kết quả: Mười hai triệu năm trăm ngàn đồng chẵn.
Nhấp chuột vào đây để mở rộng...



Chao,

Em da lam theo huong dan, nhung van khong ra duoc ket qua. #NAME?.

Cam on da giup
 
Hi, em chào cả nhà, em là thành viên cũng lâu rùi nhưng chưa có đóng góp bài nào cả cho diễn đàn cũng ngại lắm, Bác Secret_Grasses ! ơi cho em hỏi sao số tiền của em khi đọc lại bị lặp lại.
 
em vao add ins ma chang thay browse dau ca la the nao ay nhi
 
khoavu87 đã viết:
thì bạn nối thêm cái đuôi là "đồng chẵn" vào nữa là được chứ có sao đâu nhờ?
các tiện ích đều chung quy lại là tạo ra một hàm mới trong excel
do đó cũng có chức năng như các hàm bình thường.
VD : một hàm tự tạo để đọc số thành chữ có tên VNUD không có chữ đồng ở sau thì bạn làm nó có như sau:
= VNUD(a1) &" Đồng Chẵn "
bạn có thể tham khảo file này .
Nhấp chuột vào đây để mở rộng...

bạn ơi mình làm như bạn rồi nhưng phông chữ ra trông tệ quá làm thế nào để nó giữ nguyên phông cũ đây
 
Em là thành viên mới, em tải về làm có máy hiểu có máy không hiểu. em không biết làm như thế nào?
 
Lần chỉnh sửa cuối:
bạn Add-Ins vào excel. Rồi vào excel =dsa() đọc số ABC, =dsu() đọc số unicode
 

File đính kèm

Pansy_flower, cho mình hỏi, mình tải phần này về rồi mà sao ko đọc được tiếng việt, mình dùng các Font rồi, có thể giúp mình ko?
 
Add-in của bạn tvl297 xài tốt quá. Cảm ơn nhìu nhé ^^
 
cái này thiệt là hay bạn ạ! cảm ơn nhiều nhé!
 
mình muốn đọc số USD thì làm thế nào hả các bác
 
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

D
  • Đã giải quyết
Quản lý email outlook qua VBA cần giúp đỡ (1 người xem)
2
Trả lời
22
Đọc
429
nguyendang95
N
G
Xin Code xóa Module. (1 người xem)
Trả lời
7
Đọc
205
VetMini
V
S
Mở 2 cửa sổ riêng biệt (2 người xem)
2
Trả lời
30
Đọc
23K
sakuraluu
S
F
Nhập dấu . (chấm) ở bàn phím phụ không tự chuyển thành dấu , (phẩy)
Trả lời
16
Đọc
57K
tubaodn21
tubaodn21
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt (1 người xem)
    • Thích
    • Yêu thích
2
Trả lời
21
Đọc
1K
PhanTuHuong
PhanTuHuong
L
Lỗi font khi convert từ pdf
Trả lời
3
Đọc
134
lamvu0677
L
N
Khắc phục lỗi "The picture is too large and will be truncated"
Trả lời
9
Đọc
5K
SonBDND
S
GPE-Trợ Lý
[GPE] TALKSHOW: PHÂN TÍCH BÁO CÁO ĐỘ NHẠY SỬ DỤNG EXCEL SOLVER (2 người xem)
    • Thích
Trả lời
0
Đọc
914
GPE-Trợ Lý
GPE-Trợ Lý
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table
Trả lời
1
Đọc
109
khkkh
K
K
Xin dax tính tỷ trọng doanh thu (1 người xem)
Trả lời
18
Đọc
782
SteveNguyen1991
S
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
6
Đọc
210
Hoàng Tuấn 868
H
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính
    • Thích
Trả lời
0
Đọc
133
nguyendang95
N
H
Nhờ anh/chị giúp đỡ em viết công thức trừ dữ liệu theo FiFo
Trả lời
1
Đọc
118
HieuCD
H
BNTT
LockXLS - Chương trình bảo vệ an toàn cho các file bảng tính Excel
    • Thích
4 5 6
Trả lời
118
Đọc
73K
YêuCN
Y
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện. (1 người xem)
Trả lời
14
Đọc
211
thuytrangbp28
T
micam111
  • Question Question
Cách chạy nhiều đồng hồ đếm giờ trong VBA (1 người xem)
Trả lời
4
Đọc
705
thuytrangbp28
T
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước. (1 người xem)
    • Thích
2
Trả lời
26
Đọc
7K
Tuấn Bụng Bự
Tuấn Bụng Bự
Emyeuexcel
  • Question Question
In tất cả các file trong cùng 1 thư mục
Trả lời
3
Đọc
218
Hoàng Tuấn 868
H
1
Hỏi về đánh dấu hàng ngang hàng dọc bằng màu khi kích chuột vào 1 ô
Trả lời
7
Đọc
213
Gà Công Nghệ
Gà Công Nghệ
P
Excell code vba : Tìm Cell để sửa dữ liệu
    • Buồn
2
Trả lời
26
Đọc
592
Phạm Trường 80
P
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom