Ứng dụng Thông báo Hỗ trợ Đăng ký Đăng nhập
2 thành viên trả lời
NgocStar_danghiviec rangchuot Trả lời cuối cùng: 16/05/2008
Thành viên tích cực nhất

bibibobo87@gmail.com

4 lượt cảm ơn

tungtong80@vatgia.com

3 lượt cảm ơn

huynhanh@vgid.com

2 lượt cảm ơn

hanhbeo90@vgid.com

2 lượt cảm ơn

  • Hot
  • Giảm giá
  • Mới

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

      boongshop

      16/05/2008 - 16:17
      Câu hỏi này hữu ích với bạn? Cảm ơn
      1772

      Vui lòng đăng nhập ID VATGIA để gửi trả lời của bạn

      NgocStar_danghiviec

      16/05/2008 - 16:18
      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
      Đọc thêm
      . Bình luận này hữu ích với bạn? Cảm ơn

      Báo vi phạm

      rangchuot

      16/05/2008 - 16:23
      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
      Đọc thêm
      . Bình luận này hữu ích với bạn? Cảm ơn

      Báo vi phạm

      Sản phẩm từ Vatgia.com