Xin code loại bỏ tất cả từ/cụm từ không phải từ khóa

[keyword]

Em muốn lấy nội dung theo từ khóa trong một chuỗi như dưới đây thì phải làm thế nào ạ?

Dữ liệu ban đầu: abcd 23 45 ax ef 67 by ghij
Từ khóa: ax by
Kết quả: 23 45 ax 67 by
(Kết quả chỉ giữ lại từ khóa và số)
(Từ/cụm từ nhiễu là chữ, không trùng với từ khóa, và không có giới hạn số lượng/độ dài)

Mong được anh/chị giúp đỡ ạ.

 

[VetMini]

Function LocTuKhoa(ByVal chuoi As String) As String
Const TUKHOA = "|ax|by|"
LocTuKhoa = ""
For Each tu In Split(chuoi, " ")
If IsNumeric(tu) Or (InStr(TUKHOA, "|" & tu & "|") > 0) Then
LocTuKhoa = LocTuKhoa & " " & tu
End If
LocTuKhoa = Trim(LocTuKhoa)
Next tu

 

[tocxuu]

Function LocTuKhoa(ByVal chuoi As String) As String
Const TUKHOA = "|ax|by|"
LocTuKhoa = ""
For Each tu In Split(chuoi, " ")
If IsNumeric(tu) Or (InStr(TUKHOA, "|" & tu & "|") > 0) Then
LocTuKhoa = LocTuKhoa & " " & tu
End If
LocTuKhoa = Trim(LocTuKhoa)
Next tu

Anh cho em hỏi dấu "|" trong biến Const của anh có ý nghĩa gì ạ?
Em cảm ơn.

 

[VetMini]

Anh cho em hỏi dấu "|" trong biến Const của anh có ý nghĩa gì ạ?
Em cảm ơn.

1. Const là hằng, không phải là biến
2. "|" ở đây được dùng làm dấu ngăn cách chuỗi ký tự. Mục đích để vượt qua trường hợp từ này chứa từ khác, vào tạo hiểu lầm cho hàm InStr. Đây là một xảo thuật tìm từ. Trong trường hợp của bạn, dùng ký hiệu khác cũng được (.,:; ~# vân vân)

 

[keyword]

Function LocTuKhoa(ByVal chuoi As String) As String
Const TUKHOA = "|ax|by|"

Hay quá anh ạ, chỉ với 10 dòng code thần kỳ của anh đã làm thay đổi cuộc đời em, anh đã giúp em giảm được vô số thao tác thủ công bấy lâu. Em cảm ơn anh @VetMini ạ.

Em có thể xin thêm một kiểu nữa không ạ. Kiểu viết ở dạng Sub, có thêm vòng lặp quét tìm từ khóa ở bảng Từ khóa. Em xin lỗi vì sự dốt và tham của em ạ.

 

[VetMini]

Ví dụ bảng từ khóa ở "A1:A10", chuỗi ở B1, và kết quả muốn có ở C1. Dùng:
C1 = LocTuKhoaRange(B1, A1:A10)

Cóp cả hai hàm dưới đây vào Module 1

Function LocTuKhoaRange(chuoi As String, tuKhoa As Range) As String
LocTuKhoaRange = LocTuKhoa(chuoi, Application.Transpose(tuKhoa))
End Function

Private Function LocTuKhoa(chuoi As String, tuKhoa As Variant) As String
Const DELIM = "|"
Dim tu, tuKhoaStr
Debug.Print TypeName(tuKhoa)
tuKhoaStr = DELIM & Join(tuKhoa, DELIM) & DELIM
LocTuKhoa = ""
For Each tu In Split(chuoi, " ")
If IsNumeric(tu) Or (InStr(tuKhoaStr, DELIM & tu & DELIM) > 0) Then
LocTuKhoa = LocTuKhoa & " " & tu
End If
Next tu
LocTuKhoa = Trim(LocTuKhoa)
End Function

 

[keyword]

Em cảm ơn anh @VetMini đã cho code. Code bài #6 chạy đúng rồi ạ.

Em có thể hỏi nếu dữ liệu không có khoảng trống thì có thể tách lấy từ khóa và số được không ạ?

Ví dụ
Dữ liệu ban đầu: abcd:23,45ax.ef67by,ghij
Từ khóa: ax by
Kết quả: 23 45 ax 67 by
* Kết quả chỉ giữ lại từ khóa và số.

 

[VetMini]

Được nhưng gải thuật khác hoàn toàn.
Có lẽ cách dễ nhất là dùng Regex.

 

[keyword]

Có lẽ cách dễ nhất là dùng Regex.

Cảm ơn anh đã cho từ khóa, em đã tìm và xem các hướng dẫn về Regex, nhưng nó bao la quá anh ạ. Để lĩnh hội đc thì với trình của em là chưa thể được. Em xem mà chỉ thấy quay cuồng, tối tăm mặt mũi.
Anh có thể viết giúp code cụ thể cho ví dụ bài #7 của em được không ạ. Cảm ơn anh ạ.

 

[HeSanbi]

Bạn thử đoạn code dưới đây
Thực hiện
B1 = CleanTextByKeys(A1, "ax|by", TRUE, TRUE) hoặc B1 = CleanTextByKeys(A1:B1000, "ax|by", TRUE, TRUE)
Hoặc:
B1 = CleanTextByKeys(A1:B1000, 'SheetTuKhoa'!$C$1:$D$10, TRUE, TRUE)

- Đối số TRUE/FALSE thứ nhất, tự động thực hiện các hàng bên dưới
- Đối số TRUE thứ hai, tính toán lại nếu bất kỳ ô nào trong trang tính thay đổi,
nếu False thì dữ liệu đổi trong vùng A1:B1000, hàm sẽ tính toán lại.

--------------------

Function CleanTextByKeys$(ByVal Texts, ByVal Keys, _
                 Optional ByVal CleanDown As Boolean = False, _
                 Optional ByVal Calculate As Boolean = False)
  If Calculate Then Application.Volatile
  Static RE As Object
  Dim S$, Key, Text
  If VBA.IsArray(Keys) Then
    For Each Key In Keys
      If CStr(Key) <> "" Then
        S = S & VBA.IIf(S = "", "", "|") & CStr(Key)
      End If
    Next
  Else
    S = CStr(Keys)
  End If
  If VBA.TypeName(Texts) = "Range" Then
    Text = Texts(1, 1).Value2
  Else
    Text = CStr(Texts): CleanDown = False
  End If
  If RE Is Nothing Then
    Set RE = VBA.Interaction.CreateObject("VBScript.RegExp")
    RE.Global = True
    RE.MultiLine = True
    RE.IgnoreCase = False
  End If
  With RE
    .Pattern = "\d+" & VBA.IIf(S = "", "", "|") & S
    If Not .test(Text) Then Exit Function
    Dim M, Ms, Tmp$
    Set Ms = .Execute(Text)
    For Each M In Ms
      Tmp = Tmp & VBA.IIf(Tmp = "", "", " ") & M
    Next
  End With
  CleanTextByKeys = Tmp
  If CleanDown Then
    With Application
      .Evaluate "Callback_CleanTextByKeys('[" & _
      Texts(2, 1).Parent.Parent.Name & "]" & Texts(2, 1).Parent.Name & "'!" & Texts(2, 1).Address(0, 0) & _
    ", """ & S & """, '[" & .Caller.Parent.Parent.Name & "]" & .Caller.Parent.Name & "'!" & .Caller.Offset(1).Address(0, 0) & ")"
    End With
  End If
End Function

Sub Callback_CleanTextByKeys(CTBK_Range As Range, Keys, CTBK_Caller As Range)
  If CTBK_Caller Is Nothing Then Exit Sub
  Dim LR&, cLR&, I&, Total(), Arr, B As Boolean
  LR = CTBK_Range(Rows.Count - CTBK_Range.Row).End(3).Row - CTBK_Range.Row + 1
  If LR <= 0 Then Exit Sub
  B = Application.ScreenUpdating
  Application.ScreenUpdating = False
  Arr = CTBK_Range.Resize(LR).Value2
  ReDim Total(1 To LR, 1 To 1)
  For I = 1 To LR
    If Arr(I, 1) <> "" Then _
    Total(I, 1) = CleanTextByKeys(Arr(I, 1), Keys)
  Next
  CTBK_Caller(1, 1).Resize(LR).Value = Total
  cLR = CTBK_Caller(Rows.Count - CTBK_Caller.Row).End(3).Row - CTBK_Caller.Row + 1
  If cLR - LR > 0 Then _
    CTBK_Caller(LR + 1, 1).Resize(cLR - LR).ClearContents
  Application.ScreenUpdating = B
End Sub

 

[keyword]

Bạn thử đoạn code dưới đây

Wow!!! Em xin quỳ gối dập đầu cảm ơn anh @HeSanbi rất nhiều ạ.

Cảm ơn anh đã viết cho những dòng code siêu đẳng cấp, lại còn bonus thêm các kiểu option nữa.

Code đã chạy đúng như mong đợi. Option rất tuyệt vời. Em chân thành cảm ơn anh ạ.

 

[batman1]

Nếu bạn đồng ý với bác VetMini thì không thể gật đầu với bạn HeSanbi được, và ngược lại.

Không phải vô cớ mà trong bài của mình bác VetMini dùng DELIM trong

InStr(tuKhoaStr, DELIM & tu & DELIM

Dùng DELIM để không tìm thấy ax trong vd. axe

Vd. bạn nhập vào A1 = abcd 23 45 hichicaxblala ef 67 by ghij

Kết quả của bác VetMini là "23 45 67 by", của HeSanbi là "23 45 ax 67 by"

Không thể gật đầu với cả hai được. Phải chọn 1 thôi, tùy theo yêu cầu của mình. Tức nếu có vd. "123 hichicaxblala" thì bạn có cho là tìm thấy ax hay không.

 

[HeSanbi]

@batman1

Hàm trên em viết chỉ là một hàm cải tiến đơn giản.

Hàm hoàn toàn không dùng giải thuật nào ngoài RegExp.

Chỉ cần thay đổi Pattern trong Regexp để đạt được ý muốn.

Nếu là một từ khóa tách biệt thì thêm dòng dưới đây để đạt được điều đó:
S = "\b(" & S & ")\b"

Hoặc thêm tham số để ràng buộc:
Optional ByVal SingleKey As Boolean = False

if SingleKey Then S = "\b(" & S & ")\b"

 

[batman1]

@batman1

Hàm trên em viết chỉ là một hàm cải tiến đơn giản.

Hàm hoàn toàn không dùng giải thuật nào ngoài RegExp.

Chỉ cần thay đổi Pattern trong Regexp để đạt được ý muốn.

Nếu là một từ khóa tách biệt thì thêm dòng dưới đây để đạt được điều đó:
S = "\b(" & S & ")\b"

Hoặc thêm tham số để ràng buộc:
Optional ByVal SingleKey As Boolean = False

if SingleKey Then S = "\b(" & S & ")\b"

Ơ, tôi lưu ý cho chủ thớt thôi.