Nạp giá trị các từ khóa cần tìm vào mảng. Tìm kiếm tại 1 vùng, nếu có chưa các từ khóa thì bôi màu

[Đình Phán]

Chào các anh, chị.

Em mới tập tành phương thức Find nhưng loay hoay quá.
Em có 1 danh sách các từ khóa cần tìm (có thể mở rộng thêm). Em muốn nạp các giá trị này vào 1 mảng (do tìm kiếm là tiếng Việt có dấu), hiện em có tìm 1 đoạn mã nhưng sửa không được. Nhờ các anh, chị giúp đỡ.

Em cảm ơn!

Sub Find_Highlight_Comments()
Dim WS As Worksheet
Dim Match As Range
Dim Comment()
Dim Keyword()


Set WS = ActiveWorkbook.Worksheets("Sheet1")


Comment = ThisWorkbook.Sheets("Sheet1").Range("A1:A5").Value
ReDim Keyword(1 To UBound(Comment))
    'Comment(0) = "insoluble residue"
    'Comment(1) = "non-gaussian"
    'Comment(2) = "empty source well"
    'Comment(3) = "source vial not received"
    'Comment(4) = "foreign object"
    'Comment(5) = "lacks nitrogen"
    'Comment(6) = "lacks molecular"
    'Comment(7) = "could not be assayed"
    'Comment(8) = "not pass through Millipore filter"


For i = 1 To UBound(Comment)
Set Match = WS.Range("A1:A100").Find(What:=Keyword(i), LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)


    If Not Match Is Nothing Then
    FirstAddress = Match.Address
        Do
        sPos = InStr(1, Match.Value, Keyword(i))
        sLen = Len(Keyword(i))
        Match.Characters(Start:=sPos, Length:=sLen).Font.Color = RGB(255, 0, 0)
        Match.Interior.Color = RGB(255, 255, 0)
        Set Match = WS.Range("A1:A100").FindNext(Match)
        Loop While Not Match Is Nothing And Match.Address <> FirstAddress
    End If
Next
End Sub

 

[bebo021999]

Bạn nói bạn sửa code mà sửa không được. Vậy bạn muốn code làm gì, và kết quả muốn có ở đâu? Hiện tại trong file không thấy vùng tìm kiếm.Để test Bạn cần đưa đầy đủ dữ liệu vào nhé.

 

[Đình Phán]

Bạn nói bạn sửa code mà sửa không được. Vậy bạn muốn code làm gì, và kết quả muốn có ở đâu? Hiện tại trong file không thấy vùng tìm kiếm.Để test Bạn cần đưa đầy đủ dữ liệu vào nhé.

Em muốn đứng ở Sheet1 của bất kỳ 1 Active workbook nào đó, chạy code của file AAA.xlsb thì sẽ tìm kiếm các giá trị ở trong file AAA.xlsb, nếu thấy tồn tại thì bôi màu ở Sheet1 của Active workbook đó ạ.

 

[bebo021999]

Vậy bạn phải add data vào mới test được chứ.
Thay vì 2 WB, bạn test trên 2 sheets cùng 1 WB.
Tạo thêm 1 sheet nữa nhé, add data vào và tô màu kết quả muốn có