Add-in: Đổi số sang chữ trong Excel sử dụng font Unicode

Liên hệ QC
infes đã viết:
Sorry các bạn, post nhầm file đổi số cho VNI
Đây là bản đổi file cho font Unicode
Nhấp chuột vào đây để mở rộng...

bạn ơi, mình rất cảm ơn chia sẻ của bạn và bạn có thể giúp mình theo cách như này được ko ạ
ví dụ dãy số của mình là : 178.987.766.888, đơn vị tính trong bảng là 1.000 đồng thì kết quả sẽ thành: 178 nghìn 987 tỷ, 766 triệu, 888 nghìn đồng.
Cảm ơn các bạn rất nhiều ạ
 
Bài viết của bạn rất hay, mình đã làm được rồi, nhưng font không đọc được, dù mình đã tải bản full đầy đủ rồi, nguyên nhân là sao vậy ban?
 
Hàm đổi số ở post số 2 tác giả post lên hình như bị lỗi.
Với các con số sau kết quả cho ra hình như là không đúng:
#VALUE!-0.3
#VALUE!-1.1
#VALUE!-99
Mười tỷ, một đồng chẵn10000000001
Cái mười tỉ lẻ một đồng "chẵn" thì có thể là do cách đọc của tác giả, nhưng số âm bị lỗi hết thì phải.
Mình chế thử một cái các bạn test thử xem có được không
Cách dùng:
Cài addin vào sau đó tại ô cần đổi gõ dạng sau:
=bangchu(-999999999999999,"Yên Nhật, "xu", "lẻ")
=> Âm chín trăm chín mươi chín ngàn tỷ, chín trăm chín mươi chín tỷ, chín trăm chín mươi chín triệu, chín trăm chín mươi chín ngàn, chín trăm chín mươi chín Yên Nhật

=bangchu(B4,"Yên Nhật", "xu", "lẻ") trong đó ô B4 = -100000001.01
=> Âm một trăm triệu, không trăm lẻ một Yên Nhật, một xu
nếu chỉ gõ =bangso(so_can_doi) thì mặc định đơn vị là "đồng", "xu", "lẻ" -\\/.
 

File đính kèm

  • bangchu.zip
    17.6 KB · Đọc: 28
Lần chỉnh sửa cuối:
phamduylong đã viết:
Đây là hàm đổi số ra chữ cho 3 bảng mã :
Unicode: hàm DocSoUni
Vni Window: hàm DocSoVni
TCVN3 ABC: hàm DocSoAbc
Các bạn có thể tải tập tin DocsoVn.zip có sẳn 3 hàm trên.

Mã: 
'=====================
Function DocSoVni(conso) As String
s09 = Array("", " moät", " hai", " ba", " boán", " naêm", " saùu", " baûy", " taùm", " chín")
lop3 = Array("", " trieäu", " nghìn", " tyû")
If Trim(conso) = "" Then
  DocSoVni = ""
ElseIf IsNumeric(conso) = True Then
  If conso < 0 Then dau = "aâm " Else dau = ""
  conso = Application.WorksheetFunction.Round(Abs(conso), 0)
  conso = " " & conso
  conso = Replace(conso, ",", "", 1)
  vt = InStr(1, conso, "E")
  If vt > 0 Then
    sonhan = Val(Mid(conso, vt + 1))
    conso = Trim(Mid(conso, 2, vt - 2))
    conso = conso & String(sonhan - Len(conso) + 1, "0")
  End If
  conso = Trim(conso)
  sochuso = Len(conso) Mod 9
  If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
  docso = ""
  i = 1
  lop = 1
  Do
    n1 = Mid(conso, i, 1)
    n2 = Mid(conso, i + 1, 1)
    n3 = Mid(conso, i + 2, 1)
    baso = Mid(conso, i, 3)
    i = i + 3
    If n1 & n2 & n3 = "000" Then
      If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " tyû" Else s123 = ""
    Else
      If n1 = 0 Then
        If docso = "" Then s1 = "" Else s1 = " khoâng traêm"
      Else
        s1 = s09(n1) & " traêm"
      End If
      If n2 = 0 Then
        If s1 = "" Or n3 = 0 Then
          s2 = ""
        Else
          s2 = " linh"
        End If
      Else
        If n2 = 1 Then s2 = " möôøi" Else s2 = s09(n2) & " möôi"
      End If
      If n3 = 1 Then
        If n2 = 1 Or n2 = 0 Then s3 = " moät" Else s3 = " moát"
      ElseIf n3 = 5 And n2 <> 0 Then
        s3 = " laêm"
      Else
        s3 = s09(n3)
      End If
      If i > Len(conso) Then
        s123 = s1 & s2 & s3
      Else
        s123 = s1 & s2 & s3 & lop3(lop)
      End If
    End If
    lop = lop + 1
    If lop > 3 Then lop = 1
    docso = docso & s123
    If i > Len(conso) Then Exit Do
  Loop
  If docso = "" Then DocSoVni = "khoâng" Else DocSoVni = dau & Trim(docso)
Else
  DocSoVni = conso
End If
End Function
'==================================
Function DocSoAbc(conso) As String
s09 = Array("", " mét", " hai", " ba", " bèn", " n¨m", " s¸u", " b¶y", " t¸m", " chÝn")
lop3 = Array("", " triÖu", " ngh×n", " tû", " triÖu", " ngh×n", "")
If Trim(conso) = "" Then
  DocSoAbc = ""
ElseIf IsNumeric(conso) = True Then
  If conso < 0 Then dau = "©m " Else dau = ""
  conso = Application.WorksheetFunction.Round(Abs(conso), 0)
  conso = " " & conso
  conso = Replace(conso, ",", "", 1)
  vt = InStr(1, conso, "E")
  If vt > 0 Then
    sonhan = Val(Mid(conso, vt + 1))
    conso = Trim(Mid(conso, 2, vt - 2))
    conso = conso & String(sonhan - Len(conso) + 1, "0")
  End If
  conso = Trim(conso)
  sochuso = Len(conso) Mod 9
  If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
  docso = ""
  i = 1
  lop = 1
  Do
    n1 = Mid(conso, i, 1)
    n2 = Mid(conso, i + 1, 1)
    n3 = Mid(conso, i + 2, 1)
    baso = Mid(conso, i, 3)
    i = i + 3
    If n1 & n2 & n3 = "000" Then
      If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " tû" Else s123 = ""
    Else
      If n1 = 0 Then
        If docso = "" Then s1 = "" Else s1 = " kh«ng tr¨m"
      Else
        s1 = s09(n1) & " tr¨m"
      End If
      If n2 = 0 Then
        If s1 = "" Or n3 = 0 Then
          s2 = ""
        Else
          s2 = " linh"
        End If
      Else
        If n2 = 1 Then s2 = " m­êi" Else s2 = s09(n2) & " m­¬i"
      End If
      If n3 = 1 Then
        If n2 = 1 Or n2 = 0 Then s3 = " mét" Else s3 = " mèt"
      ElseIf n3 = 5 And n2 <> 0 Then
        s3 = " l¨m"
      Else
        s3 = s09(n3)
      End If
      If i > Len(conso) Then
        s123 = s1 & s2 & s3
      Else
        s123 = s1 & s2 & s3 & lop3(lop)
      End If
    End If
    lop = lop + 1
    If lop > 3 Then lop = 1
    docso = docso & s123
    If i > Len(conso) Then Exit Do
  Loop
  If docso = "" Then DocSoAbc = "kh«ng" Else DocSoAbc = dau & Trim(docso)
Else
  DocSoAbc = conso
End If
End Function
'===============================
Function DocSoUni(conso) As String
s09 = Array("", " 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")
lop3 = Array("", " tri" & ChrW(7879) & "u", " ngh" & ChrW(236) & "n", " t" & ChrW(7927))
'Stop
If Trim(conso) = "" Then
  DocSoUni = ""
ElseIf IsNumeric(conso) = True Then
  If conso < 0 Then dau = ChrW(226) & "m " Else dau = ""
  conso = Application.WorksheetFunction.Round(Abs(conso), 0)
  conso = " " & conso
  conso = Replace(conso, ",", "", 1)
  vt = InStr(1, conso, "E")
  If vt > 0 Then
    sonhan = Val(Mid(conso, vt + 1))
    conso = Trim(Mid(conso, 2, vt - 2))
    conso = conso & String(sonhan - Len(conso) + 1, "0")
  End If
  conso = Trim(conso)
  sochuso = Len(conso) Mod 9
  If sochuso > 0 Then conso = String(9 - (sochuso Mod 12), "0") & conso
  docso = ""
  i = 1
  lop = 1
  Do
    n1 = Mid(conso, i, 1)
    n2 = Mid(conso, i + 1, 1)
    n3 = Mid(conso, i + 2, 1)
    baso = Mid(conso, i, 3)
    i = i + 3
    If n1 & n2 & n3 = "000" Then
      If docso <> "" And lop = 3 And Len(conso) - i > 2 Then s123 = " t" & ChrW(7927) Else s123 = ""
    Else
      If n1 = 0 Then
        If docso = "" Then s1 = "" Else s1 = " kh" & ChrW(244) & "ng tr" & ChrW(259) & "m"
      Else
        s1 = s09(n1) & " tr" & ChrW(259) & "m"
      End If
      If n2 = 0 Then
        If s1 = "" Or n3 = 0 Then
          s2 = ""
        Else
          s2 = " linh"
        End If
      Else
        If n2 = 1 Then s2 = " m" & ChrW(432) & ChrW(7901) &  "i" Else s2 = s09(n2) & " m" & ChrW(432) & ChrW(417) &  "i"
      End If
      If n3 = 1 Then
        If n2 = 1 Or n2 = 0 Then s3 = " m" & ChrW(7897) & "t" Else s3 = " m" & ChrW(7889) & "t"
      ElseIf n3 = 5 And n2 <> 0 Then
        s3 = " l" & ChrW(259) & "m"
      Else
        s3 = s09(n3)
      End If
      If i > Len(conso) Then
        s123 = s1 & s2 & s3
      Else
        s123 = s1 & s2 & s3 & lop3(lop)
      End If
    End If
    lop = lop + 1
    If lop > 3 Then lop = 1
    docso = docso & s123
    If i > Len(conso) Then Exit Do
  Loop
  If docso = "" Then DocSoUni = "kh" & ChrW(244) & "ng" Else DocSoUni = dau & Trim(docso)
Else
  DocSoUni = conso
End If
End Function
Nhấp chuột vào đây để mở rộng...


Em đang dùng đoạn code này, GPE chỉ giúp em là em muốn sửa kết quả
"một trăm triệu đồng/."
thành
"Một trăm triệu đồng chẵn /." chỉ sửa ntn ah
 

File đính kèm

  • DocsoTV.xlam
    50.7 KB · Đọc: 27
add-in này hay nhưng mà có cách nào đổi nghàn thành nghìn được không mọi người?
 
em muốn đồi chữ ''ngàn'' thành ''nghìn'' trong hàm sau thì phải đổi như nào ah? cảm ơn anh chị!
Function VNDUni(baonhieu)
' Tien Viet tieng Viet Font Unicode


Dim KetQua, SoTien, Nhom, Chu, Dich, S1, S2, S3 As String
Dim I, J, ViTri As Byte, S As Double
Dim Hang, Doc, Dem
If baonhieu = 0 Then
KetQua = "Kh" & ChrW$(244) & "ng " & ChrW$(273) & ChrW$(7891) & "ng"
Else
If Abs(baonhieu) >= 1E+15 Then
KetQua = "S" & ChrW$(7889) & " qu" & ChrW$(225) & " l" & ChrW$(7899) & "n - H" & ChrW$(224) & "m " & ChrW$(273) & ChrW$(7893) & "i s" & ChrW$(7889) & " ra ch" & ChrW$(7919) & " Vi" & ChrW$(7879) & "t Nam; font ch" & ChrW$(7919) & " .Vntime - Copyright by MaiKa of AQN (0953-357-988)"
Else
If baonhieu < 0 Then
KetQua = ChrW$(194) & "m" & Space(1)
Else
KetQua = Space(0)
End If
SoTien = Format(Abs(baonhieu), "##############0.00")
SoTien = Right(Space(15) & SoTien, 18)
Hang = Array("None", "tr" & ChrW$(259) & "m", "m" & ChrW$(432) & ChrW$(417) & "i", "g" & ChrW$(236) & " " & ChrW$(273) & "ã")
Doc = Array("None", "ng" & ChrW$(224) & "n t" & ChrW$(7927), "t" & ChrW$(7927), "tri" & ChrW$(7879) & "u", "ng" & ChrW$(224) & "n", ChrW$(273) & ChrW$(7891) & "ng", "")
Dem = Array("None", "m" & ChrW$(7897) & "t", "hai", "ba", "b" & ChrW$(7889) & "n", "n" & ChrW$(259) & "m", "s" & ChrW$(225) & "u", "b" & ChrW$(7849) & "y", "t" & ChrW$(225) & "m", "ch" & ChrW$(237) & "n")
For I = 1 To 6
Nhom = Mid(SoTien, I * 3 - 2, 3)
If Nhom <> Space(3) Then
Select Case Nhom
Case "000"
If I = 5 Then
Chu = ChrW$(273) & ChrW$(7891) & "ng" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = "ch" & ChrW$(7861) & "n"
Case Else
S1 = Left(Nhom, 1)
S2 = Mid(Nhom, 2, 1)
S3 = Right(Nhom, 1)
Chu = Space(0)
Hang(3) = Doc(I)
For J = 1 To 3
Dich = Space(0)
S = Val(Mid(Nhom, J, 1))
If S > 0 Then
Dich = Dem(S) & Space(1) & Hang(J) & Space(1)
End If
Select Case J
Case 2 And S = 1
Dich = "m" & ChrW$(432) & ChrW$(7901) & "i" & Space(1)
Case 3 And S = 0 And Nhom <> Space(2) & "0"
Dich = Hang(J) & Space(1)
Case 3 And S = 5 And S2 <> Space(1) And S2 <> "0"
Dich = "l" & Mid(Dich, 2)
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 4) Then
Dich = "l" & ChrW$(7867) & Space(1)
End If
End Select
Chu = Chu & Dich
Next J
End Select
ViTri = InStr(1, Chu, "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7897) & "t", 1)
If ViTri > 0 Then Mid(Chu, ViTri, 9) = "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7889) & "t"
KetQua = KetQua & Chu
End If
Next I
End If
End If
VNDUni = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
 
anh chị giúp em với ah. em đang cần gấp lắm.
 
thanhnam1107 đã viết:
em muốn đồi chữ ''ngàn'' thành ''nghìn'' trong hàm sau thì phải đổi như nào ah? cảm ơn anh chị!
Function VNDUni(baonhieu)
' Tien Viet tieng Viet Font Unicode


Dim KetQua, SoTien, Nhom, Chu, Dich, S1, S2, S3 As String
Dim I, J, ViTri As Byte, S As Double
Dim Hang, Doc, Dem
If baonhieu = 0 Then
KetQua = "Kh" & ChrW$(244) & "ng " & ChrW$(273) & ChrW$(7891) & "ng"
Else
If Abs(baonhieu) >= 1E+15 Then
KetQua = "S" & ChrW$(7889) & " qu" & ChrW$(225) & " l" & ChrW$(7899) & "n - H" & ChrW$(224) & "m " & ChrW$(273) & ChrW$(7893) & "i s" & ChrW$(7889) & " ra ch" & ChrW$(7919) & " Vi" & ChrW$(7879) & "t Nam; font ch" & ChrW$(7919) & " .Vntime - Copyright by MaiKa of AQN (0953-357-988)"
Else
If baonhieu < 0 Then
KetQua = ChrW$(194) & "m" & Space(1)
Else
KetQua = Space(0)
End If
SoTien = Format(Abs(baonhieu), "##############0.00")
SoTien = Right(Space(15) & SoTien, 18)
Hang = Array("None", "tr" & ChrW$(259) & "m", "m" & ChrW$(432) & ChrW$(417) & "i", "g" & ChrW$(236) & " " & ChrW$(273) & "ã")
Doc = Array("None", "ng" & ChrW$(224) & "n t" & ChrW$(7927), "t" & ChrW$(7927), "tri" & ChrW$(7879) & "u", "ng" & ChrW$(224) & "n", ChrW$(273) & ChrW$(7891) & "ng", "")
Dem = Array("None", "m" & ChrW$(7897) & "t", "hai", "ba", "b" & ChrW$(7889) & "n", "n" & ChrW$(259) & "m", "s" & ChrW$(225) & "u", "b" & ChrW$(7849) & "y", "t" & ChrW$(225) & "m", "ch" & ChrW$(237) & "n")
For I = 1 To 6
Nhom = Mid(SoTien, I * 3 - 2, 3)
If Nhom <> Space(3) Then
Select Case Nhom
Case "000"
If I = 5 Then
Chu = ChrW$(273) & ChrW$(7891) & "ng" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = "ch" & ChrW$(7861) & "n"
Case Else
S1 = Left(Nhom, 1)
S2 = Mid(Nhom, 2, 1)
S3 = Right(Nhom, 1)
Chu = Space(0)
Hang(3) = Doc(I)
For J = 1 To 3
Dich = Space(0)
S = Val(Mid(Nhom, J, 1))
If S > 0 Then
Dich = Dem(S) & Space(1) & Hang(J) & Space(1)
End If
Select Case J
Case 2 And S = 1
Dich = "m" & ChrW$(432) & ChrW$(7901) & "i" & Space(1)
Case 3 And S = 0 And Nhom <> Space(2) & "0"
Dich = Hang(J) & Space(1)
Case 3 And S = 5 And S2 <> Space(1) And S2 <> "0"
Dich = "l" & Mid(Dich, 2)
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 4) Then
Dich = "l" & ChrW$(7867) & Space(1)
End If
End Select
Chu = Chu & Dich
Next J
End Select
ViTri = InStr(1, Chu, "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7897) & "t", 1)
If ViTri > 0 Then Mid(Chu, ViTri, 9) = "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7889) & "t"
KetQua = KetQua & Chu
End If
Next I
End If
End If
VNDUni = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
Nhấp chuột vào đây để mở rộng...
Chổ này nè bạn:
Mã: 
[COLOR=#000000]Doc = Array("None", "ng" & ChrW$(224) & "n t" & ChrW$(7927), "t" & ChrW$(7927), "tri" & ChrW$(7879) & "u", "ng" & ChrW$(224) & "n", ChrW$(273) & [/COLOR]
Bạn đổi thành
Mã: 
[COLOR=#000000]Doc = Array("None", "ngh" & ChrW$(236) & "n t" & ChrW$(7927), "t" & ChrW$(7927), "tri" & ChrW$(7879) & "u", "ngh" & ChrW$(236) & "n", ChrW$(273) & [/COLOR]
 
dạ em cảm ơn nhiều ah. từ sáng tới giờ e tìm nhiều hàm add-in đọc số rồi mà chưa ưng được cái nào có thể giải quyết đc vấn đề tại đơn vị. em vẫn muốn dùng hàm trên nhưng có nhiều chỗ e không biết phải sửa như nào cho đúng.
vd: "90.018.000" với hàm trên sẽ đọc thành:"Chín mươi triệu mười tám nghìn đồng".
mà theo đơn vị em bắt phải ghi rõ: "Chín mươi triệu, không trăm mười tám nghìn, không trăm đồng".
Vấn đề đặt ra là em muốn thêm dấu "," và "không trăm" trước đơn vị nghìn và đồng. em rất mong nhận được sự giúp đỡ của anh chị trên diễn đàn.
 
Lần chỉnh sửa cuối:
giaiphap đã viết:
Bạn sử dụng add-ins này sẽ giải quyết được vấn đề của bạn.
http://www.giaiphapexcel.com/forum/showthread.php?106992-Add-Ins-cho-Excel-2013-mới-viết-xong
Nhấp chuột vào đây để mở rộng...
rất nhiều tiện ích hay mà giờ em mới biết. về phần đọc số vnd, với những giá trị âm thì hàm vẫn không đọc được là âm.
vd: "(10.038.100)" => hàm vẫn đọc về giá trị là: "mười triệu, không trăm ba mươi tám nghìn. một trăm đồng"
em muốn là nó tự đọc là " Âm mười triệu, không trăm ba mươi tám nghìn. một trăm đồng".
 
thanhnam1107 đã viết:
rất nhiều tiện ích hay mà giờ em mới biết. về phần đọc số vnd, với những giá trị âm thì hàm vẫn không đọc được là âm.
vd: "(10.038.100)" => hàm vẫn đọc về giá trị là: "mười triệu, không trăm ba mươi tám nghìn. một trăm đồng"
em muốn là nó tự đọc là " Âm mười triệu, không trăm ba mươi tám nghìn. một trăm đồng".
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn đã góp ý, mình vừa thêm chức năng đọc số âm cho bạn rồi đấy, có thể xem lại. À mà bạn muốn góp ý cho Add-Ins của mình thì vào link sau này góp ý, chứ bạn góp ý ở đây thì chủ topic này sẽ....:=\+ :=\+ :=\+
 
Mình mò mẫn tới trang 12 thì hoa cả mắt, mình nhờ các bạn giúp bỏ từ "chẳn" trong cái đổi số này, cảm ơn các bạn nhiều
VD: 456.789,98 nó đọc là "bốn trăm năm mươi sáu triệu, bảy trăm chín mươi ngàn đồng chẵn"
mình muốn nó đọc là " bốn trăm năm mươi sáu triệu, bảy trăm tám mươi chín ngàn đồng", Không cần độc 2 số lẻ ở sau và không cần từ chẳn
Ai giúp được mình cảm ơn nhiều
 

File đính kèm

  • Doiso.xla
    20.5 KB · Đọc: 45
Lần chỉnh sửa cuối:
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

phanngoctrai1981
  • Question
Tính trung bình theo các nhóm bằng VBA
Trả lời
5
Đọc
124
phanngoctrai1981
phanngoctrai1981
kiencuong030184
  • Question
ẩn hiện dòng, cột có điều kiên
Trả lời
1
Đọc
18
SA_DQ
SA_DQ
P
Unsurpassed Сasual Dating - Legitimate Girls
Trả lời
0
Đọc
15
pta289
P
A
[Góc giúp đỡ] Tìm kiếm, lọc và lấy dữ liệu từ nhiều file Word cấu trúc giống nhau vào 1 file excel mẫu
Trả lời
4
Đọc
101
Hoàng Tuấn 868
H
Emyeuexcel
  • Question
In theo số thứ tự
    • Chấp nhận
Trả lời
1
Đọc
38
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom