Ad-in doi so thanh chu USD?

Liên hệ QC
CPH

CPH

Thành viên chính thức
Tham gia
30/10/06
Bài viết
93
Được thích
37
Toi dang tim Ad-in doi so ra chu thanh USD.
VD: 100.12 USD
KQ: Mot tram do muoi hai cent.
Mong cac ban chi giao.
Thanks
 
Thanks!
Nhưng làm cách nào để chuyển thành font TCVN3 nhi?
 
Bạn vào trang code của hàm và chọn font theo yêu cầu trong cửa sổ viết code , chỉnh sửa lại những từ tiếng Việt theo font đó
 
Bạn vào trang viết code, chọn Font chữ theo yêu cầu(Tools/Options/Editor Format) rồi chỉnh sửa những từ tiếng Việt theo font đó là được
 
Các bạn làm ơn sửa giúp cái VBA này.
Khi tôi viết 12 thì nó lại đọc là mười hai đô la cent
Luon tiện các bạn sửa luôn nó thành font TCVN3 giúp tôi với, tôi sửa mà nó cứ chạy lung tung, chuối thật.

Function USVN(Amtu)
If Amtu = 0 Then
Resp = "Khoâng USD"
Else
If Abs(Amtu) > 999999999999.99 Then
Resp = "Soá quaù lôùn"
Else
If Amtu < 0 Then
Resp = "Tröø "
Else
Resp = Space(0)
End If
Tien = Format(Abs(Amtu), "###########0.00")
Tien = Right(Space(12) + Tien, 15)
Doc = Space(0): Dem = Doc
Doc = Doc + "traêm möôi tyû "
Doc = Doc + "traêm möôi trieäu"
Doc = Doc + "traêm möôi ngaøn "
Doc = Doc + "traêm möôi ñoâla "
Doc = Doc + "traêm möôi cent "
Dem = Dem + "moät hai ba boán naêm "
Dem = Dem + "saùu baûy taùm chín "
For i = 1 To 5
NHOM = Mid(Tien, i * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If i = 4 Then
Chu = "Ñoâ la "
Else
Chu = Space(0)
End If
Case ".00"
Chu = "chaün"
Case Else
SO1 = Left(NHOM, 1)
So2 = Mid(NHOM, 2, 1)
So3 = Right(NHOM, 1)
Chu = Space(0)
For J = 1 To 3
Dich = Space(0)
S = Val(Mid(NHOM, J, 1))
If S > 0 Then
Dich = Trim(Mid(Dem, S * 5 - 4, 5)) + " " + Trim(Mid(Doc, (i - 1) * 18 + J * 6 - 5, 6)) + " "
End If
Select Case J
Case 2 And S = 1
Dich = "möôøi "
Case 3 And S = 0 And NHOM <> Space(2) + "0"
Dich = Trim(Mid(Doc, (i - 1) * 18 + J * 6 - 5, 6)) + Space(1)
Case 3 And S = 5 And So2 <> Space(1) And So2 <> "0"
Dich = "l" + Mid(Dich, 2)
Case 2 And S = 0 And So3 <> "0"
If (SO1 >= "1" And SO1 <= "9") Or (SO1 = "0" And i = 4) Then
Dich = "leû "
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"
Resp = Resp + Chu
End If
Next i
End If
End If
USVN = UCase(Left(Resp, 1)) + Mid(Resp, 2)
End Function
 
Lần chỉnh sửa cuối:
Tôi lấy cái này trong name manger (Maika) và sửa cho bạn
Function USDU(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 = "Kh" & ChrW$(244) & "ng " & ChrW$(273) & ChrW$(7891) & "ng"
Else
If Abs(baonhieu) >= 1E+15 Then
KetQua = "S" & ChrW$(7889) & " qu" & ChrW$(225) & " l" & ChrW$(7899) & "n - H" & ChrW$(224) & "m " & ChrW$(273) & ChrW$(7893) & "i s" & ChrW$(7889) & " ra ch" & ChrW$(7919) & " Vi" & ChrW$(7879) & "t Nam; font ch" & ChrW$(7919) & " .Vntime - Copyright by MaiKa of AQN (0953-357-988)"
Else
If baonhieu < 0 Then
KetQua = ChrW$(194) & "m" & Space(1)
Else
KetQua = Space(0)
End If
SoTien = Format(Abs(baonhieu), "##############0.00")
SoTien = Right(Space(15) & SoTien, 18)
Hang = Array("None", "tr" & ChrW$(259) & "m", "m" & ChrW$(432) & ChrW$(417) & "i", "g" & ChrW$(236) & " " & ChrW$(273) & "ã")
Doc = Array("None", "ng" & ChrW$(224) & "n t" & ChrW$(272), "t" & ChrW$(272), "tri" & ChrW$(7879) & "u", "ng" & ChrW$(224) & "n", "®« la", "Cent")
Dem = Array("None", "m" & ChrW$(7897) & "t", "hai", "ba", "b" & ChrW$(7889) & "n", "n" & ChrW$(259) & "m", "s" & ChrW$(225) & "u", "b" & ChrW$(7849) & "y", "t" & ChrW$(225) & "m", "ch" & ChrW$(237) & "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 = ChrW$(273) & ChrW$(7891) & "ng" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = "ch" & ChrW$(7861) & "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" & ChrW$(432) & ChrW$(7901) & "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
USDU = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
 
Bạn xem lại giúp với!
Khi viết 12,1 thì nó đọc đúng là "Mười hai đô la mười cent"
Nhưng khi viết 12 thì nó lại đọc là "Mười hai đôla cent" chứ ko phải "Mười hai đô la"

Thanks
 
Lần chỉnh sửa cuối:
12,1 thì nó đọc đúng là "Mười hai đô la mười cent" thì đúng rồi
còn bạn có chọn là USDU(stien) không, tôi test lại không bị. Để tôi tìm lại trên 4r có file TCVN rồi chỉ cho, trước mắt dùng cái này.
 
ThuNghi đã viết:
12,1 thì nó đọc đúng là "Mười hai đô la mười cent" thì đúng rồi
còn bạn có chọn là USDU(stien) không, tôi test lại không bị. Để tôi tìm lại trên 4r có file TCVN rồi chỉ cho, trước mắt dùng cái này.
Nhấp chuột vào đây để mở rộng...

Vì sao tôi làm ko đc nhỉ? nó vẫn đọc là 12 đô la cent.
Có ai giup tôi sửa cái VBA này không?
Tôi muốn khi viết 12,1 thì nó đọc thành "Mười hai đô la Mỹ và mười cents", khi viết 12 thì nó đọc thành "Mười hai đô la Mỹ"
Tôi đang cần gấp!
Mong được giúp đỡ, Xin cảm ơn.
 
Function USDTCVN(baonhieu)
' Tien Viet tieng Viet Font TCVN - MaiKa of AQN (0953-357-988)"

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 = "Kh«ng ®ång"
Else
If Abs(baonhieu) >= 1E+15 Then
KetQua = "Sè qu¸ lín - Hµm ®æi sè ra ch÷ ViÖt Nam; font ch÷ .Vntime "

Else
If baonhieu < 0 Then
KetQua = "¢m" & Space(1)
Else
KetQua = Space(0)
End If
SoTien = Format(Abs(baonhieu), "##############0.00")
SoTien = Right(Space(15) & SoTien, 18)
Hang = Array("None", "tr¨m", "m­¬i", "g× ®ã")
Doc = Array("None", "ngµn tû", "tû", "triÖu", "ngµn", "®« la Mü", "cent")
Dem = Array("None", "mét", "hai", "ba", "bèn", "n¨m", "s¸u", "bÈy", "t¸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 = "®« la Mü" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = ""
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 = "lÎ" & Space(1)
End If
End Select
Chu = Chu & Dich
Next J
End Select
ViTri = InStr(1, Chu, "m­¬i mét", 1)
If ViTri > 0 Then Mid(Chu, ViTri, 9) = "m­¬i mèt"
KetQua = KetQua & Chu
End If
Next I
End If
End If
USDTCVN = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
 
Cảm ơn bạn Thu Nghị rất nhiều, nhưng bạn có thể cho thêm từ và khi đọc thêm từ Cent đc ko?
Ví dụ: 12,1 thì là Mười hai đô la mỹ và mười cent.
Vì Công ty tôi bắt buộc phải viết dúng chính xác từng từ một.
Rất mong bạn Thu Nghị giúp cho chót.
Cảm ơn bạn rất nhiều.
 
Lần chỉnh sửa cuối:
Với đoạn code trên bạn thêm vài dòng lệnh là được thôi (đoạn chữ màu đỏ)
Mã: 
Function USDTCVN(baonhieu)
' Tien Viet tieng Viet Font TCVN - MaiKa of AQN (0953-357-988)"
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 = "Kh«ng ®ång"
Else
    If Abs(baonhieu) >= 1E+15 Then
        KetQua = "Sè qu¸ lín - Hµm ®æi sè ra ch÷ ViÖt Nam; font ch÷ .Vntime "
    Else
        If baonhieu < 0 Then
            KetQua = "¢m" & Space(1)
        Else
            KetQua = Space(0)
        End If
        
        SoTien = Format(Abs(baonhieu), "##############0.00")
        SoTien = Right(Space(15) & SoTien, 18)
        Hang = Array("None", "tr¨m", "m&shy;¬i", "g× ®ã")
        Doc = Array("None", "ngµn tû", "tû", "triÖu", "ngµn", "®« la Mü", "cent")
        Dem = Array("None", "mét", "hai", "ba", "bèn", "n¨m", "s¸u", "bÈy", "t¸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 = "®« la Mü" & Space(1)
                    Else
                        Chu = Space(0)
                    End If
                Case ".00"
                    Chu = ""
                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&shy;ê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Î" & Space(1)
                            End If
                        End Select
                        
                        Chu = Chu & Dich
                    Next J
                End Select
                
                ViTri = InStr(1, Chu, "m&shy;¬i mét", 1)
                If ViTri > 0 Then Mid(Chu, ViTri, 9) = "m&shy;¬i mèt"
                KetQua = KetQua & Chu
            End If
        Next I
    End If
End If
'Viet chu hoa dau cau
USDTCVN = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
[COLOR=red][B]If InStr(1, UCase(Left(KetQua, 1)) & Mid(KetQua, 2), "cent", 1) > 0 Then
    USDTCVN = Replace(USDTCVN, "®« la Mü", "®« la Mü vµ")
End If[/B][/COLOR]
End Function
 
Chào Các Bác ,
Sao Hàm Này nó không chạy trên sheet cũ của Em, sheet mới toanh thì nó chạy được, em dung đổi số ra chữ trên sheet cũ đang có dữ liệu thì không được,
 
trithanh đã viết:
Chào Các Bác ,
Sao Hàm Này nó không chạy trên sheet cũ của Em, sheet mới toanh thì nó chạy được, em dung đổi số ra chữ trên sheet cũ đang có dữ liệu thì không được,
Nhấp chuột vào đây để mở rộng...
Bạn copy đoạn code trên rồi save as thành add-in, sau đó vào tools\add-ins\browse đến chỗ để add-in vừa save là ok.
 
Ban CPH oi, dùng chương trình nào để save as thành add-in vay? và cho mình hỏi luồn là dùng chương trình nào để mở file add-in da lam va mình muốn sửa thêm vào,
cám ơn bạn nhiều.
 
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

K
Nhờ mọi người hỗ trợ giúp mình về tìm kiếm trong VBA. Mình sẽ gửi chút chi phí cafe cám ơn nhiều ạ
    • Cười
Trả lời
10
Đọc
91
kentshjnks
K
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
12
Đọc
318
S.Ha
S
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
8
Đọc
193
DeTong
D
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
2
Trả lời
21
Đọc
368
Emyeuexcel
Emyeuexcel
hongquan93vn
Giữ được Hide dòng khi dùng "clear" trong phần học
Trả lời
3
Đọc
62
Hoàng Tuấn 868
H
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