Hỗ trợ tách từ Tiếng Việt không có dấu bằng VBA

[Tình nghĩa giang hồ]

Chào anh chị em có vấn đề này nhờ anh chị hỗ trợ giúp em.
Dữ liệu của em nằm ở cột A trong sheet GPE
Kết quả mong muốn của em là cột B trong sheet GPE
Nội dung:
Từ cột A, tách dữ liệu không có dấu tiếng Việt sang cột B, sau đó remove dulicate cột B.
Dữ liệu không dấu là là các chữ abcd.. không có tính số ở đây nhé anh chị.
Nhờ anh chị hỗ trợ giúp em sheet GPE nhé. Em cảm ơn anh chị.

Cho em nói thêm. Mục đích chính của bài này thật sự đúng của nó là tách các từ tiếng Anh ra, nhưng tách tiếng Anh thì không khả thi. Nên em chỉ mong muốn là tách từ không có dấu thôi, tách được vậy là em mừng lắm rồi. (còn chuyện lọc thêm tiếng việt tiếng Anh thì em xử lý sau)
Sau khi có được từ tiếng Anh thì em sẽ bỏ nó vào Sheet Replace để làm chuyển đổi. Cái này là em nói thêm để rõ mục đích chính của em thôi nhé anh chị.

 

[Nhattanktnn]

Chào anh chị em có vấn đề này nhờ anh chị hỗ trợ giúp em.
Dữ liệu của em nằm ở cột A trong sheet GPE
Kết quả mong muốn của em là cột B trong sheet GPE
Nội dung:
Từ cột A, tách dữ liệu không có dấu tiếng Việt sang cột B, sau đó remove dulicate cột B.
Dữ liệu không dấu là là các chữ abcd.. không có tính số ở đây nhé anh chị.
Nhờ anh chị hỗ trợ giúp em sheet GPE nhé. Em cảm ơn anh chị.

Cho em nói thêm. Mục đích chính của bài này thật sự đúng của nó là tách các từ tiếng Anh ra, nhưng tách tiếng Anh thì không khả thi. Nên em chỉ mong muốn là tách từ không có dấu thôi, tách được vậy là em mừng lắm rồi. (còn chuyện lọc thêm tiếng việt tiếng Anh thì em xử lý sau)
Sau khi có được từ tiếng Anh thì em sẽ bỏ nó vào Sheet Replace để làm chuyển đổi. Cái này là em nói thêm để rõ mục đích chính của em thôi nhé anh chị.

Bạn lên mạng kiếm code RegexExtract rồi mình xem hỗ trợ pattern

 

[Tình nghĩa giang hồ]

Bạn lên mạng kiếm code RegexExtract rồi mình xem hỗ trợ pattern

Không biết ý anh có phải là cái này không nhỉ

Function RegexExtract(ByVal text As String, ByVal pattern As String) As String
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
   
    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .pattern = pattern
    End With
   
    If regex.test(text) Then
        Set matches = regex.Execute(text)
        RegexExtract = matches(0)
    Else
        RegexExtract = ""
    End If
End Function

Bản sao của REGEX

docs.google.com

 

[Nhattanktnn]

Không biết ý anh có phải là cái này không nhỉ

Function RegexExtract(ByVal text As String, ByVal pattern As String) As String
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
  
    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .pattern = pattern
    End With
  
    If regex.test(text) Then
        Set matches = regex.Execute(text)
        RegexExtract = matches(0)
    Else
        RegexExtract = ""
    End If
End Function

Bản sao của REGEX

docs.google.com

Chắc phải chế biến một chút, Code này:

Option Explicit

Public Function RegexExtract(Value As Variant, Pattern As String, k As Long) As String
    Static objRegex As Object
    Dim colRegexMatches As Object
    'k bat dau tu 1
    If objRegex Is Nothing Then Set objRegex = CreateObject("VBScript.Regexp")
    With objRegex
        .Pattern = Pattern
        .Global = True
        .IgnoreCase = False
        .MultiLine = True
    End With
    RegexExtract = objRegex.Execute(Value)(k - 1).submatches(0)
End Function

Và trên sheet dùng công thức này: Kéo xuống, kéo sang phải:

=IFERROR(RegexExtract($A2,"(?:^|\s)([a-zA-Z]+)(?=\s|$)",COLUMN(A1)),"")

 

[Tình nghĩa giang hồ]

Chắc phải chế biến một chút, Code này:

Option Explicit

Public Function RegexExtract(Value As Variant, Pattern As String, k As Long) As String
    Static objRegex As Object
    Dim colRegexMatches As Object
    'k bat dau tu 1
    If objRegex Is Nothing Then Set objRegex = CreateObject("VBScript.Regexp")
    With objRegex
        .Pattern = Pattern
        .Global = True
        .IgnoreCase = False
        .MultiLine = True
    End With
    RegexExtract = objRegex.Execute(Value)(k - 1).submatches(0)
End Function

Và trên sheet dùng công thức này: Kéo xuống, kéo sang phải:

=IFERROR(RegexExtract($A2,"(?:^|\s)([a-zA-Z]+)(?=\s|$)",COLUMN(A1)),"")

Công thức của anh đã tách được 1 từ tiếng Anh, nhưng giả sử trong câu có 2 hoặc nhiều từ tiếng anh thì không tách được.
Hiện tại em đã tách được nhiều từ tiếng Anh. Nhưng kết quá chưa ra được như ý muốn.

Option Explicit

Public Function ExtractEnglishWords(Value As Variant) As String
    Dim words() As String
    Dim word As String
    Dim i As Long
    
    words = Split(Value, " ")
    
    For i = LBound(words) To UBound(words)
        word = words(i)
        
        If IsEnglishWord(word) Then
            ExtractEnglishWords = ExtractEnglishWords & word & " "
        End If
    Next i
    
    ExtractEnglishWords = Trim(ExtractEnglishWords)
End Function

Public Function IsEnglishWord(word As String) As Boolean
    Dim i As Long
    
    For i = 1 To Len(word)
        If Not (Asc(Mid(word, i, 1)) >= 65 And Asc(Mid(word, i, 1)) <= 90) And _
           Not (Asc(Mid(word, i, 1)) >= 97 And Asc(Mid(word, i, 1)) <= 122) Then
            IsEnglishWord = False
            Exit Function
        End If
    Next i
    
    IsEnglishWord = True
End Function

Công thức

=ExtractEnglishWords(A2)

Nhưng vẫn chưa ra được kết quả mong muốn mỹ mãn của em, còn thiếu tí xíu

 

[Nhattanktnn]

Công thức của anh đã tách được 1 từ tiếng Anh, nhưng giả sử trong câu có 2 hoặc nhiều từ tiếng anh thì không tách được.

Đã làm thế này chưa?

Kéo xuống, kéo sang phải

 

[Tình nghĩa giang hồ]

Đã làm thế này chưa?

À, được rùi anh, hồi nãy em quên kéo sang phải.
Em cảm ơn anh nhiều.