Predefinição:Taxonomia/Genasauria

Sub HighlightAllKeywords()

   ' 매크로 실행되는 엑셀 파일의 경로
   Dim basePath As String
   basePath = ThisWorkbook.Path

   ' 설정 파일 열기
   Dim settingWorkbook As Workbook
   Dim settingWorksheet As Worksheet
   Dim keywordsRange As Range
   Dim keywords() As Variant
   Dim lastRow As Long
   Dim i As Integer

   ' setting.xlsx 파일을 매크로와 동일한 경로에서 찾기
   Set settingWorkbook = Workbooks.Open(basePath & "\Setting.xlsx")
   Set settingWorksheet = settingWorkbook.Sheets("Setting")

   ' 키워드 범위 정의 (F2부터 마지막까지)
   lastRow = settingWorksheet.Cells(settingWorksheet.Rows.Count, "F").End(xlUp).Row
   Set keywordsRange = settingWorksheet.Range("F2:F" & lastRow)

   ' 키워드를 배열로 변환
   ReDim keywords(1 To keywordsRange.Rows.Count)
   For i = 1 To keywordsRange.Rows.Count
       keywords(i) = keywordsRange.Cells(i, 1).Value
   Next i

   ' 설정 파일 닫기
   settingWorkbook.Close False

   ' 대상 워크시트 선택 (예: Sheet1)
   Dim ws As Worksheet
   Set ws = ThisWorkbook.Sheets("Sheet1")

   ' J열 범위 내 모든 셀 선택 (J2부터 마지막 행까지)
   lastRow = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
   Dim rangeToSearch As Range
   Set rangeToSearch = ws.Range("J2:J" & lastRow)

   ' 강조할 셀 및 키워드 반복
   Dim cell As Range
   Dim keyword As Variant
   Dim startPos As Long
   Dim length As Long
   Dim searchPos As Long

   ' 각 키워드에 대해 H열의 모든 셀을 순회하며 강조
   For Each cell In rangeToSearch
       If Not IsEmpty(cell.Value) Then
           For Each keyword In keywords
               startPos = 1
               searchPos = InStr(startPos, cell.Value, keyword, vbTextCompare)

               ' 키워드가 발견될 때마다 강조
               Do While searchPos > 0
                   length = Len(keyword)

                   ' 키워드 부분만 굵게 설정 및 텍스트 색 변경
                   With cell.Characters(Start:=searchPos, length:=length).Font
                       .Bold = True
                       .Color = RGB(0, 0, 255) ' 파란색 텍스트
                   End With

                   ' 다음 인스턴스를 찾기 위해 검색 위치를 업데이트
                   startPos = searchPos + length
                   searchPos = InStr(startPos, cell.Value, keyword, vbTextCompare)
               Loop
           Next keyword
       End If
   Next cell

End Sub