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