Hàm UDF Đọc số thành chữ, chuyển chữ thành số, kể cả số thập phân

Chia sẻ bởi:hands
★★★★★
Quảng cáo

*****CẬP NHẬT: 16/08/2022 *****

Hôm nay tôi mang đến cho các bạn một giải pháp đọc số thành chữ tối ưu, và đa dạng tùy chọn kiểu trả về kết quả để phù hợp với nhu cầu từng trường hợp cho văn bản hay biên bản, hàm mới này thay vì chỉ đọc duy nhất số thì hàm có thể đọc được số trong chuỗi chứa số, để bỏ qua giai đoạn bóc tách số trong chuỗi số tốn kém tài nguyên.
Ưu điểm của hàm có để đọc số rất lớn, lớn nhất có thể. Và hàm cũng có thể đọc số thập phân một cách dễ dàng.

Hàm có thêm các tham số tiện lợi:

  • Các kiểu trả kết quả hoa thường tùy chọn
  • Tùy chọn đọc hoặc không đọc "không trăm"
  • Tùy chọn thay thế số đã đọc hoặc thêm vào sau số đó.
  • Đọc các số riêng lẻ trong chuỗi chứa số, hoặc trích xuất số và đọc
  • Thêm chuỗi trước hoặc sau

Thêm một hàm dịch ngược chữ thành số, sẽ giúp các bạn dễ dàng chuyển chuỗi thành số, rà soát lỗi viết chữ.

Thêm một hàm nữa dùng để chuyển mọi kiểu định dạng số về dạng cơ bản để dễ dàng phân tích.

Trong định dạng số có nhiều kiểu định dạng khác nhau, ví dụ như:

  • 1,000,000,00 số này vẫn đọc là một tỷ tuy nhiên được lọc bớt số 0 để rút gọn.
  • 1.25E+20 hoặc 1.25E-20 Đây là một định dạng rút ngắn một số quá dài so với số mắt thường đọc được.
  • Các số được định dạng phân cách nghìn: 1,000,000 , 1.000.000, 1.000_000.000.000_000.000.000
  • Số lũy thừa: chỉ có thể đọc tại ô chứa giá trị

HƯỚNG DẪN HÀM – SpellIt:

Tham số của hàm:

=SpellIt(Text,IndexNumbers,ReadZeroHundred,groupDivision,ReplaceNumbers,SentenceSpace,unitType,LetterCaseType,AddStringLeft,AddStringRight)

Vị trí
Tham số
Kiểu
Giá trị mặc định
Diễn giải

1

Text
Chuỗi chứa số

Chuỗi chứa số để thực hiện đọc số

2

IndexNumbers
Số hoặc mảng

-1

Nếu để số, 0 thì đọc tất cả số, 1 đọc số thứ nhất, {1, 3} đọc số vị trí 1 và 3, Số âm -2 thì trích và đọc duy nhất vị trí số thứ 2 trong chuỗi chứa số

3

ReadZeroHundred
Có/Không

Đọc hoặc không đọc "Không Trăm"

4

groupDivision
Có/Không

Nhóm mỗi 1000 đơn vị với dấu phẩy (,)

5

ReplaceNumbers
Có/Không

0

Thay thế hoặc thêm vào đằng sau số được đọc

6

SpellPercent

Có/Không

0
Đọc phần trăm

7

SentenceSpace
Chuỗi
Dấu cách
Dấu nối chuỗi khi đọc số

8

unitType
Số nguyên

0

Kiểu đơn vị sẽ thêm vào, có 9 kiểu:
0 – Để trống (Tự động tìm đơn vị nếu có)
1 – thêm chuỗi "Đồng."
2 – thêm chuỗi "(Đồng.)"
3 – thêm chuỗi "[Đồng.]"
4 – thêm chuỗi "USD."
5 – thêm chuỗi "(USD.)"
6 – thêm chuỗi ""
7 – thêm chuỗi "Đô-la."
8 – thêm chuỗi "(Đô-la.)"
9 – thêm chuỗi "[Đô-la.]"

9

LetterCaseType
Số nguyên

0

Trả kết quả các kiểu viết Hoa, có 5 kiểu
0 – Chữ thường
1 – Chữ hoa ký tự đầu tiên của chuỗi
2 – Chữ Hoa ký tự đầu tất cả từ
3 – Chữ Hoa
4 – Chữ Hoa sau mỗi 1000 đơn vị

10

AddStringLeft
Thêm chuỗi bên trái
Rỗng
Thêm chuỗi bên trái nếu cần thiết

11

AddStringRight
Thêm chuỗi bên phải
Rỗng

Thêm chuỗi bên phải nếu cần thiết

Cách viết hàm nhanh, gõ vào ô chuỗi =S_ReadNumber( và ấn tổ hợp phím Ctrl+Shift+A, để xem tất cả tham số của hàm.

Nếu gõ công thức =S_ReadNumber("abc 1230000000") thì các tham số còn lại sẽ là mặc định.

Nếu gõ công thức với dấu phẩy để trống như sau: =S_ReadNumber("abc 1230000000",,,,," ")
Thì các tham số tương ứng sẽ vẫn nhận giá trị mặc định

Các bạn nên thay đổi đối số trong mã để phù hợp với nhu cầu đọc số của bạn, để khi viết hàm sẽ nhanh hơn, mà không phải mất thời gian nhập các đối số vào hàm.

Để tham khảo thêm các hàm do chính tôi phát triển các bạn có thể click vào tag hesanbi udf ở đầu trang

Function CaseLower(): CaseLower = 0: End Function
Function CaseSentence(): CaseSentence = 1: End Function
Function CaseTitle(): CaseTitle = 2: End Function
Function CaseUpper(): CaseUpper = 3: End Function
Function CaseThousands(): CaseThousands = 4: End Function

Public Function SpellIt(ByVal Text As String, _
                       Optional ByVal IndexNumbers = -1, _
                       Optional ByVal ReadZeroHundred As Boolean = True, _
                       Optional ByVal groupDivision As Boolean = True, _
                       Optional ByVal ReplaceNumbers As Boolean = False, _
                       Optional ByVal SpellPercent As Boolean = False, _
                       Optional ByVal SentenceSpace As String = " ", _
                       Optional ByVal unitType As Integer = 0, _
                       Optional ByVal LetterCaseType As Integer = 4, _
                       Optional ByVal AddStringLeft As String, _
                       Optional ByVal AddStringRight As String _
                       ) As String
  unitType = unitType Mod 10
  LetterCaseType = LetterCaseType Mod 5
  Const n_ = vbNullString
  Dim n, nn$, sn, sn1, isn0, isn1, in1, INs, ll$, lr$, lrp$, gd$
  Dim a, b, i, j, jj%, k%, ik%, lmk%, hn%, l, m1$, m2$, s$, s0$, r$, r0$
  Dim t0$, t1$, t2$, t3$, t4$, t5$, b0$, ut$, ss$, g%, p1
  ss = SentenceSpace
  g = LetterCaseType
  If groupDivision And ss = " " Then gd = ","
  Static c, D, E, F, h, p, q
  If Not IsArray(c) Then
    c = Array("kh" & ChrW(244) & "ng", "m" & ChrW(7897) & "t", "hai", "ba", "b" & ChrW(7889) & "n", "n" & ChrW(259) & "m", "s" & ChrW(225) & "u", "b" & ChrW(7843) & "y", "t" & ChrW(225) & "m", "ch" & ChrW(237) & "n")
    D = Array(n_, "m" & ChrW(432) & ChrW(417) & "i", "tr" & ChrW(259) & "m", "ngh" & ChrW(236) & "n", "tri" & ChrW(7879) & "u", "t" & ChrW(7927))
    D = Array(D(0), D(1), D(2), D(3), D(1), D(2), D(4), D(1), D(2), D(5))
    E = "l" & ChrW(7867)
    F = Array("m" & ChrW(7889) & "t", "l" & ChrW(259) & "m", "m" & ChrW(432) & ChrW(7901) & "i")
    h = Array("ph" & ChrW(7849) & "y", "ch" & ChrW(7845) & "m", ChrW(273) & ChrW(7891) & "ng")
    p = Array(ChrW(273) & ChrW(7891) & "ng", "VN" & ChrW(272), "USD", "Dollar", ChrW(273) & ChrW(244) & "-la")
    q = Array(n_, " " & p(0) & ".", " (" & p(0) & ".)", " [" & p(0) & ".]", _
                " USD.", " (USD.)", " [USD.]", _
                " " & p(4) & ".", " (" & p(4) & ".)", " [" & p(4) & ".]")
  End If
  INs = IndexNumbers

If Not IsArray(INs) Then
    If IsNumeric(INs) Then
      INs = CDec(INs):  If INs <> 0 Then INs = Array(INs)
    Else
      INs = Array(1)
    End If
  End If
  ut = q(unitType)

sn = Split(Replace(Text, vbCr, n_), vbLf)
  For isn0 = 0 To UBound(sn)
    sn1 = Split(sn(isn0), " ")
    For isn1 = UBound(sn1) To 0 Step -1
      n = sn1(isn1):
      If p1 = Empty Then
        For p1 = 0 To UBound(p)
          If n = p(p1) Or n Like p(p1) & "[,.]" _
          Or n Like "(" & p(p1) & ")" Or n Like "(" & p(p1) & ")[,.]" Or n = "(" & p(p1) & ".)" _
          Or n Like "[[]" & p(p1) & "]" Or n Like "[[]" & p(p1) & "][,.]" Or n = "[[]" & p(p1) & ".]" Then
            If unitType = 0 Then
              Select Case p1
              Case 1, 2: ut = q(3)
              Case 3, 4, 5: ut = q(9)
              End Select
            End If
            p1 = isn1: GoTo isn
          End If
        Next
        p1 = Empty
      End If
      nn = n_: GoSub read
      If ReplaceNumbers Then
        sn1(isn1) = nn
      Else
        If p1 = Empty Then
          If nn = n_ Then
            sn1(isn1) = n
          Else
            sn1(isn1) = sn1(isn1) & " " & nn
          End If
        Else
          sn1(p1) = sn1(p1) & " " & nn: p1 = Empty
        End If
      End If
isn:
    Next
    sn(isn0) = Join(sn1, " ")
  Next
  SpellIt = Join(sn, vbLf)
Exit Function
speak:
  k = 0: r = n_:  l = Len(s0): t4 = n_: t5 = n_: hn = -1
  For i = l To 1 Step -1
    m1 = Mid(s0, i, 1): t0 = n_: t1 = n_: t2 = n_: t3 = n_
    Select Case True
    Case m1 Like "#":
      If i > 1 Then m2 = Mid(s0, i - 1, 1) Else m2 = n_
      t1 = c(CInt(m1)): t2 = D(k)
      Select Case g
      Case 2: If t1 <> n_ Then Mid(t1, 1, 1) = UCase(Mid(t1, 1, 1))
        If t2 <> n_ Then Mid(t2, 1, 1) = UCase(Mid(t2, 1, 1))
      End Select
      Select Case k
      Case 0, 3, 6, 9: ' LeÒ, NghiÌn, Triêòu, TyÒ
        If m1 = "0" Then
          Select Case k
          Case 9: hn = 0
            If b0 <> n_ And b0 <> "0" Then
              t2 = t2 & t5
            End If
            b0 = "0"
          Case 0: b0 = "0": GoTo n
          Case Else: b0 = t2: GoTo n
          End Select
          t1 = n_: t3 = t2
        Else
          Select Case True
          Case g = 4 And hn >= 0: Mid(r, 1, 1) = UCase(Mid(r, 1, 1))
          End Select
          hn = k
          If b0 <> "0" Then
            t2 = t2 & t5
          End If
          If m2 = n_ Then
          ElseIf m2 = "0" Then
            r = E & ss & t1 & IIf(t2 = n_, n_, ss) & t2 & t4 & r: t4 = ss: t5 = gd: GoSub s: GoTo n
          Else
            If m2 = "1" Then
              If m1 = "5" Then t1 = F(1) 'Lãm
            Else
              Select Case m1:
              Case "1": t1 = F(0):  'Môìt
              Case "5": t1 = F(1):  'Lãm
              End Select
            End If
          End If
          t3 = t1 & IIf(t2 = n_, n_, ss) & t2
          b0 = n_
        End If
      Case 1, 4, 7: 'Chuòc
        If m1 > "0" Then
          Select Case m1:
          Case "1": t3 = F(2) 't1 = n_: t2 = F(2):
          Case Else: t3 = t1 & ss & t2
          End Select
          If b0 <> "0" And b0 <> n_ Then
            t3 = t3 & ss & b0
          End If
          b0 = n_: hn = k
        Else
          If b0 = n_ Then b0 = "0"
          GoTo n
        End If
      Case 2, 5, 8: 'Trãm
        t3 = t1 & ss & t2
        Select Case g
        Case 4: Mid(t3, 1, 1) = UCase(Mid(t3, 1, 1))
        End Select
        If m1 = "0" Then
          If ReadZeroHundred And hn > 0 And hn < k Then
          Else
            Select Case True
            Case g = 4 And hn >= 0 And b0 = n_: Mid(r, 1, 1) = UCase(Mid(r, 1, 1))
            End Select
            b0 = t2: GoTo n
          End If
        Else
          hn = 0
          If b0 <> "0" And b0 <> n_ Then t3 = t3 & ss & b0
          b0 = n_
        End If
      End Select
      r = t0 & t3 & t4 & r: t4 = ss: t5 = gd
n:
      If k >= 9 Then k = 0
      lmk = k
      k = k + 1
    Case Else: Return
    End Select
  Next
Return

read:
  If n Like "[(""{]*[)}""]" Or n Like "[[]*]" Then
    ll = Left(n, 1): lr = Right(n, 1): n = Mid(n, 2, Len(n) - 2)
  End If
  Select Case True
  Case n Like "*#_#*#.#*": n = Replace(n, "_", n_)
  Case n Like "*#_#*#,#*": n = Replace(n, "_", n_): n = Replace(n, ",", ".")
  Case n Like "*#,#*[.,]#*": n = Replace(n, ",", n_)
  Case n Like "*#.#*[.,]#*": n = Replace(n, ",", "#"): n = Replace(n, ".", n_): n = Replace(n, "#", ".")
  End Select
  If Not IsNumeric(n) Then
    Return
  End If
  If IsArray(INs) Then
    ik = ik + 1
    For Each in1 In INs
      If Abs(in1) = ik Then GoTo read1
    Next
    Return
  End If
read1:
  If n Like "*.*E+*" Then
    a = Split(n, "E+")
    b = Split(a(0), "."): l = CInt(a(1)) - Len(b(1))
    n = b(0) & b(1) & String(l, "0")
  ElseIf n Like "*.*E-*" Then
    a = Split(n, "E-")
    b = Split(a(0), "."): l = CInt(a(1)) - 1
    n = "0." & String(l, "0") & Join(b, "")
  End If

If n Like "-*" Then n = Mid(n, 2): r0 = ChrW(194) & "m " Else r0 = n_
  a = Split(n, "."): b = a: jj = UBound(a)
  If jj > 1 Then Return
  If Not SpellPercent Then jj = 0
  For j = jj To 0 Step -1
    s = a(j): l = Len(s)
    If j = 1 Then
      For i = l To 1 Step -1
        m1 = Mid(s, i, 1): If m1 <> "0" Then s = Left(s, i): l = i:  Exit For
      Next
      If s = "0" Or s = n_ Then ReDim Preserve a(0): GoTo nj
      s0 = "1" & String(l, "0"): GoSub speak
      lrp = Replace(r, c(1) & ss, n_): r = n_
    End If
    For i = 1 To l
      m1 = Mid(s, i, 1): If m1 <> "0" Then s = Mid(s, i): l = l - i + 1: Exit For
    Next
    If s = "0" Or s = n_ Then r = c(0) Else s0 = s: GoSub speak
    If j = 1 Then
      If s = n_ Then
        ReDim Preserve a(0)
      Else
        Select Case g
        Case 4: Mid(r, 1, 1) = UCase(Left(r, 1)): Mid(lrp, 1, 1) = UCase(Left(lrp, 1))
        End Select
        a(j) = r & ss & "/ph" & ChrW(7847) & "n/" & ss & lrp
      End If
    Else
      Select Case g
      Case 4: Mid(r, 1, 1) = UCase(Left(r, 1))
      End Select
      a(j) = r
    End If
nj:
    r = n_
  Next
  If SpellPercent Then
    n = r0 & Join(a, ss & "{" & h(1) & "}" & ss) & ut
  Else
     n = r0 & a(0) & ut
  End If
  Select Case g
  Case 1: Mid(n, 1, 1) = UCase(Left(n, 1))
  Case 3: n = UCase(n)
  End Select

nn = ll & AddStringLeft & n & AddStringRight & lr
  If in1 < 0 Then SpellIt = nn: Exit Function
Return
s:
If k >= 9 Then k = 0
k = k + 1: i = i - 1:
Return
End Function

Là Phiên bản đầu tiên nên có thể xảy ra lỗi trong quá trình sử dụng, các bạn nên tham khảo trước khi sử dụng mã.

Để sử dụng được hàm S_ReadNumber trong ứng dụng Excel của bạn hãy sao chép mã vào Module.

www.giaiphapexcel.com/diendan/threads/h%C3%A0m-udf-%C4%90%E1%BB%8Dc-s%E1%BB%91-th%C3%A0nh-ch%E1%BB%AF-chuy%E1%BB%83n-ch%E1%BB%AF-th%C3%A0nh-s%E1%BB%91-k%E1%BB%83-c%E1%BA%A3-s%E1%BB%91-th%E1%BA%ADp-ph%C3%A2n.160234/

Ứng dụng AI và Chat GPT trong Quản trị nhân sự
Khóa học SprinGO phù hợp

Ứng dụng AI và Chat GPT trong Quản trị nhân sự

Học xong khóa này, học viên có thể: Hiểu đúng bản chất AI, các nhóm AI phổ biến và cách AI “hoạt động” ở...

Xem khóa học
★★★★★ 5 ★ 1 👤 2 ▥ 0
Quảng cáo

Bạn nên đọc

Bình luận

Quảng cáo

Cũ vẫn chất

Xem thêm