CÔNG TY CỔ PHẦN BLUESOFTS

CÔNG TY CỔ PHẦN BLUESOFTS

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ố 1234567890là "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