CÔNG TY CỔ PHẦN BLUESOFTS

CÔNG TY CỔ PHẦN BLUESOFTS

Lập trình VBA tạo hàm đếm số ký tự UTF8


Lập trình hàm LENUTF8, mục đích đếm ra số ký tự unicode sau khi đã chuyển đổi về chuỗi UTF8. 
Cách cái đặt trong Excel
+ Bước 1: Từ file Excel của bạn, nhấn ALT+F11 để vào cửa sổ VBA, nhìn sang cửa sổ bên trái "Project - VBA Project", nếu không thấy cửa sổ này hãy vào menu View-> Project Explorer (CTRL+R)., bấm chuột vào tên file bạn muốn nhúng code VBA.
+ Bước 2: Vào menu Insert -> Module
+ Bước 3: Dán toàn bộ khối code VBA của tôi dưới đây vào cửa sổ module vừa tạo (nằm phía bên phải).

Option Explicit 
'Author: Nguyen Duy Tuan
'Website: https://bluesofts.net/daotaothuchanh/lap-trinh-vba-co-ban-tao-macro.html
#If VBA7 Then 
Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" ( ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long, ByVal lpMultiByteStr As LongPtr, ByVal cbMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long 
Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" ( ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As LongPtr, ByVal cchMultiByte As Long, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As Long ) As Long 
#Else 
Private Declare Function WideCharToMultiByte Lib "kernel32" ( ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cbMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long 
Private Declare Function MultiByteToWideChar Lib "kernel32" ( ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long ) As Long 
#End If 
Private Const CP_UTF8 = 65001 
Function LenUTF8(UnicodeStr As String) As Long 
   Dim b() As Byte 
   b = UnicodeStrToUTF8Bytes(UnicodeStr) 
   LenUTF8 = UBound(b) - LBound(b) + 1 
End Function 
Public Function UnicodeStrToUTF8Bytes(UnicodeStr As String) As Byte() 
   Dim nBytes As Long 
   Dim Buffer() As Byte 
   UnicodeStrToUTF8Bytes = vbNullString 
   If Len(UnicodeStr) < 1 Then Exit Function 
   nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(UnicodeStr), -1, 0&, 0&, 0&, 0&) 
   ReDim Buffer(nBytes - 2) 
   nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(UnicodeStr), -1, ByVal VarPtr(Buffer(0)), nBytes - 1, 0&, 0&) 
   UnicodeStrToUTF8Bytes = Buffer 
End Function 

+ Bước 4: nấn ALT+F11 để quay trở về màn hình bảng tính - Worksheet.
Giả xử ô A1 chứa chuỗi "Dữ liệu"
Tại B1 bạn nhập công thức
=LENUTF8(A1) kết quả là 11

Chức các bạn thành công.

Tác giả: Nguyễn Duy Tuân