Thứ Tư, 24 tháng 2, 2016

Hàm đọc vừa số vừa chữ trong Excel tạo bằng VBA

Tặng các bạn hàm NumAndText để đọc vừa số vừa chữ ở đơn vị tiền tệ. Ví dụ cần đọc con số 1234567890 là "1 Tỷ 234 Triệu 567 Ngàn 890 Đồng". Chúng ta chỉ cần gõ công thức =NumAndText(1234567890).
Thực hiện các bước sau:
Bước 1: ALT+F11 vào môi trường VBA. Vào menu Insert->Module - Tạo module
Bước 2: Copy đoạn code dưới đây dán vào module
'----COPY CODE
Function NumAndText(ByVal Amount As Double, _
                    Optional ByVal StrUnit As String = "Dong") As String
    'Author: Nguyen Duy Tuan - duytuan@bluesofts.net
    Dim CountGroup&, ArrSo, StrSo$, I&, nSkip&, S$, Ub&
    Dim Doc(3)
  
    If StrUnit = "Dong" Then StrUnit = ChrW(272) & ChrW(7891) & "ng"
  
    Doc(0) = "T" & ChrW(7927) ' "Ty"
    Doc(1) = "Tri" & ChrW(7879) & "u" ' "Trieu"
    Doc(2) = "Ngàn" ' "Ngan"
    Doc(3) = StrUnit
  
    StrSo = Format(Amount, "#,##0")
  
    ArrSo = Split(StrSo, ",")
    Ub = UBound(ArrSo)
    CountGroup = Ub - LBound(ArrSo)
    nSkip = 4 - CountGroup
    For I = LBound(ArrSo) To Ub
        S = RemoveZeroLeading(ArrSo(I))
        If S <> "" Then
            NumAndText = NumAndText & IIf(I = 0, "", " ") & _
                    S & " " & Doc(nSkip + I - 1)
        Else
            If I = Ub Then
                NumAndText = NumAndText & " " & Doc(nSkip + I - 1)
            End If
        End If
    Next
    StrUnit = Trim(StrUnit)
End Function
'-----------------------------------------------------------------
Function RemoveZeroLeading(ByVal S As String) As String
    Dim I&
    For I = 1 To Len(S)
        If Mid(S, I, 1) <> "0" Then
            Exit For
        End If
    Next
    RemoveZeroLeading = Mid(S, I)
End Function
'----KẾT THÚC COPY CODE
Bước 3. Thực hành. Bạn nhấn ALT+F11 để ra môi trường bảng tính. Nhập công thức:
=NumAndText(1234567890) sẽ đọc là: 1 Tỷ 234 Triệu 567 Ngàn 890 Đồng

Bạn có thể đọc các con số bất kỳ trong phạm vi cao nhất tỷ đồng luôn đúng.
=NumAndText(1234567890)
=NumAndText(12345678)
=NumAndText(1234567)
=NumAndText(123456)
=NumAndText(12345)
=NumAndText(1234)
=NumAndText(123)
=NumAndText(12)
DOWNLOAD
Tác giả: Nguyễn Duy Tuân - Công ty Cổ phần Bluesofts

0 nhận xét: