Ban nao co biet cong thuc "doi tu so thanh chu" trong Excel k cho minh biet voi?

Option Explicit 'Hàm đọc số Function Bangchu(so) Dim kq, viet, dai, tung, i 'Làm tròn, biến thành chuỗi để đưa vào biến viet viet = Str(Round(so, 0)) 'độ dài của chuỗi đă biến thành... dai = Len(viet) 'Đánh vần từng con số một theo chiều dài của chuỗi "số"... For i = 1 To dai - 1 tung = doc(Right(Left(viet, dai - i + 1), 1), i) kq = tung + " " + kq 'Thêm tiêu đề hàng ngàn triệu tỷ đối với từng nhóm 3 con số Select Case i Case 3 If (i + 1) < dai Then kq = "ngàn " + kq End If Case 6 If (i + 1) < dai Then kq = "triệu " + kq End If Case 9 If (i + 1) < dai Then kq = "tỷ " + kq End If Case 12 If (i + 1) < dai Then kq = "nghìn tỉ " + kq End If End Select Next ' Đặt trạng thái nếu có lỗi thì bỏ qua. On Error Resume Next 'Tiến hành thay thế các cụm từ ngang ngang thành từ ngữ giao tiếp 'thông thường. Thông qua hàm Replace. If Left(Trim(kq), 3) = "mốt" Then kq = "Một" + Mid(LTrim(kq), 4, Len(kq) - 4) End If kq = kq + " đồng chẵn" kq = Replace(kq, " ", " ") kq = Replace(kq, "mươi mươi", "mươi") kq = Replace(kq, "mười mươi", "mười") kq = Replace(kq, "mười mốt", "mười một") kq = Replace(kq, " linh mươi", "") kq = Replace(kq, " linh đồng", "đồng") kq = Replace(kq, " không trăm tỷ", "") kq = Replace(kq, " không trăm triệu", "") kq = Replace(kq, " không trăm ngàn", "") kq = Replace(kq, " không trăm đồng", " đồng") kq = Replace(kq, " trăm mốt", " trăm một") Bangchu = UCase(Left(kq, 1)) + Mid(kq, 2, Len(kq) - 1) End Function 'Hàm doc để đánh vần từng con số 1 Function doc(s, i) Dim kq Select Case s Case "0" If (i Mod 3) = 1 Then kq = "mươi" ElseIf (i Mod 3) = 2 Then kq = "linh" Else kq = "không" End If Case "1" If (i Mod 3) = 1 Then kq = "mốt" ElseIf (i Mod 3) = 2 Then kq = "mười" Else kq = "một" End If Case "2" kq = "hai" Case "3" kq = "ba" Case "4" kq = "bốn" Case "5" kq = "năm" Case "6" kq = "sáu" Case "7" kq = "bảy" Case "8" kq = "tám" Case "9" kq = "chín" End Select If ((i Mod 3) = 0) And (kq <> "linh") Then kq = kq + " trăm" ElseIf (i Mod 3) = 2 And (kq <> "mươi") Then kq = kq + " mươi" End If doc = kq End Function

Vì không thể gõ trực tiếp tiếng Việt Unicode vào một hàm VBA, bạn cần bổ sung một hàm chuyển đổi UnicodeChar (vào ngay trong Add-Ins). Function UnicodeChar(UniCharCode As String) As String On Error GoTo Loi Dim str Dim desStr As String Dim I If Mid(UniCharCode, 1, 1) = ";" Then UniCharCode = Mid(UniCharCode, 2) End If If Right(UniCharCode, 1) = ";" Then UniCharCode = Mid(UniCharCode, 1, Len(UniCharCode) - 1) End If str = UniCharCode str = Split(str, ";") For I = LBound(str) To UBound(str) desStr = desStr & ChrW$("&H" & str(I)) Next UniCodeChar = desStr Loi: Exit Function End Function Nhập hàm SoRaChu như dưới đây. Lưu ý, các chuỗi chứa mã Unicode tiếng Việt phải được gõ chính xác, các dấu chấm phẩy rất quan trọng. Function SoRaChu(ByVal NumCurrency As Currency) As String Static CharVND(9) As String, BangChu As String, I As Integer Dim SoLe, SoDoi As Integer, PhanChan, Ten As String Dim DonViTien As String, DonViLe As String Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer Dim Dong As Integer, Tram As Integer, Muoi As Integer, DonVi As Integer DonViTien = ";111;1ED3;6E;67" ' đồng DonViLe = ";78;75" ' xu If NumCurrency = 0 Then SoRaChu = UniCodeChar(";4B;68;F4;6E;67;20" & DonViTien) Exit Function End If If NumCurrency > 922337203685477# Then ' Số lớn nhất của loại CURRENCY SoRaChu = UniCodeChar(";4B;68;F4;6E;67;20;111;1ED5;69;20;111;1B0;1EE3;63;20;73" & _ ";1ED1;20;6C;1EDB;6E;20;68;1A1;6E;20;39;32;32;2C;33;33;37" & _ ";2C;32;30;33;2C;36;38;35;2C;34;37;37") Exit Function End If CharVND(1) = ";6D;1ED9;74" ' một CharVND(2) = ";68;61;69" ' hai CharVND(3) = ";62;61" ' ba CharVND(4) = ";62;1ED1;6E" ' bốn CharVND(5) = ";6E;103;6D" ' năm CharVND(6) = ";73;E1;75" ' sáu CharVND(7) = ";62;1EA3;79" ' bảy CharVND(8) = ";74;E1;6D" ' tám CharVND(9) = ";63;68;ED;6E" ' chín SoLe = Int((NumCurrency - Int(NumCurrency)) * 100) ' 2 kí số PhanChan = Trim$(str$(Int(NumCurrency))) PhanChan = Space(15 - Len(PhanChan)) + PhanChan NganTy = Val(Left(PhanChan, 3)) Ty = Val(Mid$(PhanChan, 4, 3)) Trieu = Val(Mid$(PhanChan, 7, 3)) Ngan = Val(Mid$(PhanChan, 10, 3)) Dong = Val(Mid$(PhanChan, 13, 3)) If NganTy = 0 And Ty = 0 And Trieu = 0 And Ngan = 0 And Dong = 0 Then BangChu = ";6B;68;F4;6E;67;20" + DonViTien + ";20" I = 5 Else BangChu = "" I = 0 End If '----------------------------------------------------- ' Bắt đầu đổi '----------------------------------------------------- While I <= 5 Select Case I Case 0 SoDoi = NganTy Ten = ";6E;67;E0;6E;20;74;1EF7" ' ngàn tỷ Case 1 SoDoi = Ty Ten = ";74;1EF7" ' tỷ Case 2 SoDoi = Trieu Ten = ";74;72;69;1EC7;75" ' triệu Case 3 SoDoi = Ngan Ten = ";6E;67;E0;6E" ' ngàn Case 4 SoDoi = Dong Ten = DonViTien ' đồng Case 5 SoDoi = SoLe Ten = DonViLe ' xu End Select If SoDoi 0 Then Tram = Int(SoDoi / 100) Muoi = Int((SoDoi - Tram * 100) / 10) DonVi = (SoDoi - Tram * 100) - Muoi * 10 If Right(BangChu, 3) = ";20" Then BangChu = Left(BangChu, Len(BangChu) - 3) End If BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";2C;20") + _ IIf(Tram 0, Trim(CharVND(Tram)) + ";20;74;72;103;6D;20", "") If Muoi = 0 And Tram 0 And DonVi 0 Then BangChu = BangChu + ";6C;1EBB;20" Else If Muoi 0 Then BangChu = BangChu + IIf(Muoi 0 And Muoi 1, _ Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20") End If End If If Muoi 0 And DonVi = 5 Then BangChu = BangChu + ";6C;103;6D;20" + Ten + ";20" Else If Muoi > 1 And DonVi = 1 Then BangChu = BangChu + ";6D;1ED1;74;20" + Ten + ";20" Else BangChu = BangChu + IIf(DonVi 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten) + ";20" End If End If Else BangChu = BangChu + IIf(I = 4, DonViTien + "", "") End If I = I + 1 Wend If SoLe = 0 Then BangChu = BangChu + IIf(Right(BangChu, 3) = ";20", "", ";20") + ";63;68;1EB5;6E" End If BangChu = UniCodeChar(BangChu) Đổi sang tiếng Việt Unicode ' Đổi chữ cái đầu tiên thành chữ hoa Mid$(BangChu, 1, 1) = UCase$(Mid$(BangChu, 1, 1)) SoRaChu = BangChu End Function Theo Echip