VBA Function hàm bỏ dấu tiếng việt (2 người xem)

locbanh · 14/9/18

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 http://support.microsoft.com/kb/272138
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 ----------------

huuthang_bd · 14/9/18

Chủ thớt dùng add-in này thử xem. Đồ cổ nhưng vẫn dùng được.

locbanh · 14/9/18

Dù sao cũng cám ơn các ACE đã quan tâm.
File này là khách hàng gửi mình đâu nhúng tay vào đươc
Mình muốn xin Function bỏ dẩu tiếng việt để mình bỏ chung macro chạy 1 lần ra file luôn.
Hiện tại mình đang thêm 1 công đoạn là dủng unikey bỏ dấu trước khi chạy macro và muốn bỏ qua công đoạn này.

befaint · 14/9/18

hpkhuong đã viết:
Paste vào đó -> To UNICODE

Em làm thử với "ACE" được kết quả như này.

"Ăn C** Em"!

batman1 · 14/9/18

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

Mã:

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

locbanh · 15/9/18

batman1 đã viết:
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

Mã:

Sub khong_dau() ........................................... End Sub

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.

Phuocam · 15/9/18

locbanh đã viết:
+ cột D2 chì cần nhập "=BoDau(C2)"

Bạn thêm hàm này vào:

Mã:

Public Function BoDau(str As String) As String
BoDau = SourceToDest(str, src_uni, dst_khongdau)
End Function

batman1 · 15/9/18

locbanh đã viết:
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.

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

Mã:

=SourceToDest(C2;1;5)

copy xuống dưới

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

locbanh · 18/9/18

Cám ơn mọi người rất nhiều.

ndduyen · 10/4/19

Sử dụng công thức này ok này:
Function BoDau(ByVal noiDung As String) As String
Dim i As Long
Dim iMa As Long
Dim sChar As String
Dim nChuyen As String
BoDau = AscW(noiDung)
For i = 1 To Len(noiDung)
sChar = Mid(noiDung, i, 1)
If sChar <> "" Then
iMa = AscW(sChar)
End If
Select Case iMa
Case 273
nChuyen = nChuyen & "d"
Case 272
nChuyen = nChuyen & "D"
Case 224, 225, 226, 227, 259, 7841, 7843, 7845, 7847, 7849, 7851, 7853, 7855, 7857, 7859, 7861, 7863
nChuyen = nChuyen & "a"
Case 192, 193, 194, 195, 258, 7840, 7842, 7844, 7846, 7848, 7850, 7852, 7854, 7856, 7858, 7860, 7862
nChuyen = nChuyen & "A"
Case 232, 233, 234, 7865, 7867, 7869, 7871, 7873, 7875, 7877, 7879
nChuyen = nChuyen & "e"
Case 200, 201, 202, 7864, 7866, 7868, 7870, 7872, 7874, 7876, 7878
nChuyen = nChuyen & "E"
Case 236, 237, 297, 7881, 7883
nChuyen = nChuyen & "i"
Case 204, 205, 296, 7880, 7882
nChuyen = nChuyen & "I"
Case 242, 243, 244, 245, 417, 7885, 7887, 7889, 7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907
nChuyen = nChuyen & "o"
Case 210, 211, 212, 213, 416, 7884, 7886, 7888, 7890, 7892, 7894, 7896, 7898, 7900, 7902, 7904, 7906
nChuyen = nChuyen & "O"
Case 249, 250, 361, 432, 7909, 7911, 7913, 7915, 7917, 7919, 7921
nChuyen = nChuyen & "u"
Case 217, 218, 360, 431, 7908, 7910, 7912, 7914, 7916, 7918, 7920
nChuyen = nChuyen & "U"
Case 253, 7923, 7925, 7927, 7929
nChuyen = nChuyen & "y"
Case 221, 7922, 7924, 7926, 7928
nChuyen = nChuyen & "Y"
Case Else
nChuyen = nChuyen & sChar
End Select
Next
BoDau = nChuyen
End Function

locbanh · 19/4/19

ndduyen đã viết:
Sử dụng công thức này ok này:
Function BoDau(ByVal noiDung As String) As String
...............................
End Function

Cám ơn bạn nhiều

lupin212 · 18/8/21

batman1 đã viết:
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

Mã:

=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.

batman1 · 18/8/21

lupin212 đã viết:
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)

lupin212 · 18/8/21

batman1 đã viết:
Ở 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)

Tuyệt vời quá, cám ơn bác nhiều

em mù khoản này, may có bác hỗ trợ

VBA Function hàm bỏ dấu tiếng việt (2 người xem)

Người dùng đang xem chủ đề này

locbanh

Thành viên chính thức

File đính kèm

huuthang_bd

Chuyên gia GPE

locbanh

Thành viên chính thức

befaint

|||||||||||||

batman1

Thành viên gạo cội

File đính kèm

locbanh

Thành viên chính thức

Phuocam

Thành viên mới

batman1

Thành viên gạo cội

locbanh

Thành viên chính thức

ndduyen

Thành viên mới

locbanh

Thành viên chính thức

lupin212

Thành viên mới

batman1

Thành viên gạo cội

lupin212

Thành viên mới

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

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

Đếm ngược thời gian