VBA Function hàm bỏ dấu tiếng việt

Chia sẻ bởi:hands

★★★★★

‹ File excel ứng dụng trong nhập xuất... [Xin hướng dẫn]Đối chiếu dữ liệu trong... ›

Quảng cáo

Chào các ACE mình có vấn đề cần ACE giúp đở về hàm bỏ dấu tiếng việt
Sau khi tra cứu trên google thì có rất nhiều hàm bỏ dấu tiếng việt ( bỏ dấu Uni, bỏ dấu Vn3, bỏ dấu Vni ) nhưng khách hàng gửi file cho mình không biết gỏ kiểu gì??? mà áp dụng mấy hàm đó không bỏ hết được dấu. nên việc macrro chạy tiếp phía sau trở nên khó khăn hơn.
Nên trước khi chạy mình thường sử dụng "UniKey" (Ctrl+Shilft+F6) để bỏ dấu, rồi mới dám chạy macro tiếp tục….
Mình có đính kèm file nhờ ACE xem giúp có hàm bỏ dấu nào tốt hơn ko?
Hiện hàm bỏ dấu mình đang sử dung là :

Function BoDau(Text As String) As String
  Dim AsciiDict As Object
  Set AsciiDict = CreateObject("scripting.dictionary")
  AsciiDict(192) = "A"
  AsciiDict(193) = "A"
  AsciiDict(194) = "A"
  AsciiDict(195) = "A"
  AsciiDict(196) = "A"
  AsciiDict(197) = "A"
  AsciiDict(199) = "C"
  AsciiDict(200) = "E"
  AsciiDict(201) = "E"
  AsciiDict(202) = "E"
  AsciiDict(203) = "E"
  AsciiDict(204) = "I"
  AsciiDict(205) = "I"
  AsciiDict(206) = "I"
  AsciiDict(207) = "I"
  AsciiDict(208) = "D"
  AsciiDict(209) = "N"
  AsciiDict(210) = "O"
  AsciiDict(211) = "O"
  AsciiDict(212) = "O"
  AsciiDict(213) = "O"
  AsciiDict(214) = "O"
  AsciiDict(217) = "U"
  AsciiDict(218) = "U"
  AsciiDict(219) = "U"
  AsciiDict(220) = "U"
  AsciiDict(221) = "Y"
  AsciiDict(224) = "a"
  AsciiDict(225) = "a"
  AsciiDict(226) = "a"
  AsciiDict(227) = "a"
  AsciiDict(228) = "a"
  AsciiDict(229) = "a"
  AsciiDict(231) = "c"
  AsciiDict(232) = "e"
  AsciiDict(233) = "e"
  AsciiDict(234) = "e"
  AsciiDict(235) = "e"
  AsciiDict(236) = "i"
  AsciiDict(237) = "i"
  AsciiDict(238) = "i"
  AsciiDict(239) = "i"
  AsciiDict(240) = "d"
  AsciiDict(241) = "n"
  AsciiDict(242) = "o"
  AsciiDict(243) = "o"
  AsciiDict(244) = "o"
  AsciiDict(245) = "o"
  AsciiDict(246) = "o"
  AsciiDict(249) = "u"
  AsciiDict(250) = "u"
  AsciiDict(251) = "u"
  AsciiDict(252) = "u"
  AsciiDict(253) = "y"
  AsciiDict(255) = "y"
  AsciiDict(352) = "S"
  AsciiDict(353) = "s"
  AsciiDict(376) = "Y"
  AsciiDict(381) = "Z"
  AsciiDict(382) = "z"
  AsciiDict(258) = "A"
  AsciiDict(259) = "a"
  AsciiDict(272) = "D"
  AsciiDict(273) = "d"
  AsciiDict(296) = "I"
  AsciiDict(297) = "i"
  AsciiDict(360) = "U"
  AsciiDict(361) = "u"
  AsciiDict(416) = "O"
  AsciiDict(417) = "o"
  AsciiDict(431) = "U"
  AsciiDict(432) = "u"
  AsciiDict(7840) = "A"
  AsciiDict(7841) = "a"
  AsciiDict(7842) = "A"
  AsciiDict(7843) = "a"
  AsciiDict(7844) = "A"
  AsciiDict(7845) = "a"
  AsciiDict(7846) = "A"
  AsciiDict(7847) = "a"
  AsciiDict(7848) = "A"
  AsciiDict(7849) = "a"
  AsciiDict(7850) = "A"
  AsciiDict(7851) = "a"
  AsciiDict(7852) = "A"
  AsciiDict(7853) = "a"
  AsciiDict(7854) = "A"
  AsciiDict(7855) = "a"
  AsciiDict(7856) = "A"
  AsciiDict(7857) = "a"
  AsciiDict(7858) = "A"
  AsciiDict(7859) = "a"
  AsciiDict(7860) = "A"
  AsciiDict(7861) = "a"
  AsciiDict(7862) = "A"
  AsciiDict(7863) = "a"
  AsciiDict(7864) = "E"
  AsciiDict(7865) = "e"
  AsciiDict(7866) = "E"
  AsciiDict(7867) = "e"
  AsciiDict(7868) = "E"
  AsciiDict(7869) = "e"
  AsciiDict(7870) = "E"
  AsciiDict(7871) = "e"
  AsciiDict(7872) = "E"
  AsciiDict(7873) = "e"
  AsciiDict(7874) = "E"
  AsciiDict(7875) = "e"
  AsciiDict(7876) = "E"
  AsciiDict(7877) = "e"
  AsciiDict(7878) = "E"
  AsciiDict(7879) = "e"
  AsciiDict(7880) = "I"
  AsciiDict(7881) = "i"
  AsciiDict(7882) = "I"
  AsciiDict(7883) = "i"
  AsciiDict(7884) = "O"
  AsciiDict(7885) = "o"
  AsciiDict(7886) = "O"
  AsciiDict(7887) = "o"
  AsciiDict(7888) = "O"
  AsciiDict(7889) = "o"
  AsciiDict(7890) = "O"
  AsciiDict(7891) = "o"
  AsciiDict(7892) = "O"
  AsciiDict(7893) = "o"
  AsciiDict(7894) = "O"
  AsciiDict(7895) = "o"
  AsciiDict(7896) = "O"
  AsciiDict(7897) = "o"
  AsciiDict(7898) = "O"
  AsciiDict(7899) = "o"
  AsciiDict(7900) = "O"
  AsciiDict(7901) = "o"
  AsciiDict(7902) = "O"
  AsciiDict(7903) = "o"
  AsciiDict(7904) = "O"
  AsciiDict(7905) = "o"
  AsciiDict(7906) = "O"
  AsciiDict(7907) = "o"
  AsciiDict(7908) = "U"
  AsciiDict(7909) = "u"
  AsciiDict(7910) = "U"
  AsciiDict(7911) = "u"
  AsciiDict(7912) = "U"
  AsciiDict(7913) = "u"
  AsciiDict(7914) = "U"
  AsciiDict(7915) = "u"
  AsciiDict(7916) = "U"
  AsciiDict(7917) = "u"
  AsciiDict(7918) = "U"
  AsciiDict(7919) = "u"
  AsciiDict(7920) = "U"
  AsciiDict(7921) = "u"
  AsciiDict(7922) = "Y"
  AsciiDict(7923) = "y"
  AsciiDict(7924) = "Y"
  AsciiDict(7925) = "y"
  AsciiDict(7926) = "Y"
  AsciiDict(7927) = "y"
  AsciiDict(7928) = "Y"
  AsciiDict(7929) = "y"
  AsciiDict(8363) = "d"
  Text = Trim(Text)
  If Text = "" Then Exit Function
  Dim Char As String, _
    NormalizedText As String, _
    UnicodeCharCode As Long, _
    i As Long
  'Remove accent marks (diacritics) from text
  For i = 1 To Len(Text)
    Char = Mid(Text, i, 1)
    UnicodeCharCode = AscW(Char)
    If (UnicodeCharCode < 0) Then
      'See [URL]https://support.microsoft.com/kb/272138[/URL]
      UnicodeCharCode = 65536 + UnicodeCharCode
    End If
    If AsciiDict.Exists(UnicodeCharCode) Then
      NormalizedText = NormalizedText & AsciiDict.Item(UnicodeCharCode)
    Else
      NormalizedText = NormalizedText & Char
    End If
  Next
  BoDau = NormalizedText
End Function

————– Thanks ACE nhiều —————-

Tôi viết từ thủa ban đầu nhưng lười không muốn xem lại và tối ưu.

1. Alt + F11 -> menu Insert -> Module -> dán code trong tập tin đính kèm vào module mới thêm

2. Thêm tiếp 1 Module và dán code

Sub khong_dau()
Dim lastRow As Long, r As Long, data
    With ThisWorkbook.Worksheets("Ma Full")
        lastRow = .cells(Rows.Count, "C").End(xlUp).Row
        If lastRow < 2 Then Exit Sub
        data = .Range("C2:C" & lastRow).Value
        For r = 1 To UBound(data)
            If data(r, 1) <> "" Then
                data(r, 1) = SourceToDest(data(r, 1), src_uni, dst_khongdau)
            End If
        Next r
        .Range("D2:D" & lastRow).Value = data
    End With
End Sub

www.giaiphapexcel.com/diendan/threads/vba-function-h%C3%A0m-b%E1%BB%8F-d%E1%BA%A5u-ti%E1%BA%BFng-vi%E1%BB%87t.137635/

Cám ơn A batman1 rất nhiều Code này là quá cao siêu rồi. em làm theo a và chạy được rồi.
Nhưng E chỉ cần 1 cái Function đơn giàn thôi không phải chạy tùm lum Sub ( gà như em nhìn như đám rừng bấm F8 chạy cũng ko biết gì luôn hihihi )
Vi du Function BoDau ()
+ ô C2 = Giải Pháp Excel
+ cột D2 chì cần nhập "=BoDau(C2)" kết quả ô D2 là = Giai Phap Excel

Em chỉ cần đơn giản vậy thôi. Nhờ A cứu giúp.

Bạn thêm hàm này vào:
Public Function BoDau(str As String) As String
BoDau = SourceToDest(str, src_uni, dst_khongdau)
End Function

Thế thì bạn chỉ cần thêm code trong tập tin.

Khi dùng thì …

Vd. công thức cho D2

=SourceToDest(C2;1;5)

copy xuống dưới

Không cần viết thêm hàm BoDau đâu.

Phiền anh cho em hỏi, =SourceToDest(C2;1;5) ở đây 1 và 5 ý nghĩa là gì vậy ạ?

//Em đang tìm tool để bỏ dấu, nhưng các hàm VBA trên mạng lại không đáp ứng đc một số tên, ví dụ: Lý Hùng Cường, mỗi tool của anh là tuyệt nhất nhưng em chưa hiểu ý nghĩa lắm.
Cám ơn anh.

Ở bài #6 trong tập tin đính kèm có đoạn

Public Enum convert_dest
dst_uni = 1
dst_vni = 2
dst_vn3 = 3
dst_windows1258 = 4
dst_khongdau = 5
End Enum

Public Enum convert_source
src_uni = 1
src_vni = 2
src_vn3 = 3
src_windows1258 = 4
End Enum

Tức 1 = src_uni (dữ liệu nguồn là unicode), còn 5 = dst_khongdau (kết quả là chuỗi không dấu)

vd. khác.
1. Nếu muốn chuyển từ unicode (dựng sẵn hay tổ hợp) sang unicode dựng sẵn thì KẾT QUẢ = SourceToDest(text; src_uni; dst_uni) = SourceToDest(text; 1; 1)
Unicode dựng sẵn là khi dùng Unikey mà chọn bảng mã Unicode. Unicode tổ hợp là khi chọn bảng mã Unicode tổ hợp.

2. unicode -> windows1258: kết quả = SourceToDest(text; src_uni; dst_windows1258) = SourceToDest(text; 1; 4)