728x90

찾는 글자색에 색상을 주는 FIND VBA



'하나를 하더라도 최선을'님이 만들어 주신 VBA Code 입니다.

찾고자 하는 특정 단어만 다른 색으로 변경하고 싶을 때



가령 팀장이라는 단어만 찾아서 색깔을 파란색으로 변경하고 싶다고 하면

FIND VBA 를 이용하여 단어를 찾아서 바로 글자색을 변경한다.


Characters(start, length)에서 start 는 시작 문자 번호이며 length는 글자 수

InStr 함수는 한 문자열 안에 특정 문자열이 처음으로 나타난 위치를 정수(Long) 값으로 반환

  - InStr(start, 검색되는 문자식, 찾을 문자식, compare)

  - start 를 지정하지 않으면 첫 문자에서 검색을 시작

  - start 와 compare 는 선택요소로 생략해도 된다.

  - 반환할 위치가 없으면(찾을 문자식이 없으면) 0 을 반환한다. 따라서 IF 조건문에서 활용되기도 한다.


Option Explicit
Sub Character_ColorSet()
    Dim rngTarget As Range     '//대상 범위 지정변수
    Dim C As Range
    Dim FindText As String
    Dim strAddr As String
    Dim S As Integer
   
    Application.ScreenUpdating = False  '//화면 업데이트 일시 정지
    Set rngTarget = ActiveSheet.UsedRange
    'Set rngTarget = Range([A1], Cells(Rows.Count, "C").End(3))
    '// End(3) 은 End(xlUp), 데이터가 있는 마지막행까지 자동으로 찾음
   
    FindText = InputBox("검색할 문자 입력") '//검색할 문자를 변수에 넣음
   
    With rngTarget
        .Font.Bold = False
        .Font.ColorIndex = xlAutomatic
        Set C = .Find(what:=FindText, lookat:=xlPart)
       
        If Not C Is Nothing Then
            strAddr = C.Address '// 찾은 셀의 주소를 변수에 넣음
            Do
                S = 1
                Do
                    With C.Characters(Start:=InStr(S, C, FindText), Length:=Len(FindText)).Font
                          '.Bold = True   '// 굵은 글씨로 표시하고 싶으면
                           .Color = vbBlue '// 글자색 표시, vbGreen 녹색 vbRed 빨간색
                    End With
                    S = InStr(S, C, FindText) + Len(FindText)
                Loop While InStr(S, C, FindText)
                Set C = .FindNext(C) '// 다음 찾은 데이터를 변수에
            Loop While Not C Is Nothing And strAddr <> C.Address
            '// 검색 일치하지 않거나 처음 찾은 셀이 아닐때까지 무한 반복
        End If
   
    End With
   
    Set rngTarget = Nothing '// 변수 초기화
End Sub



결과는 아래 보는 것과 같이 찾는 단어가 같은 셀에 여러번 들어가도 찾을 수 있다는 것입니다.




특정단어찾기VBA.xlsm


======================================================================

★ 여러 단어 검색하는 코드(하나를 하더라도 최선을 님이 작성한 코드)

Sub Character_ColorSet()
    Dim rngTarget As Range '//대상 범위 지정변수
    Dim C As Range
    Dim FindText As String
    Dim strAddr As String
    Dim S As Integer
   
    Application.ScreenUpdating = False  '//화면 업데이트 일시 정지
    Set rngTarget = ActiveSheet.UsedRange
    'Set rngTarget = Range([A1], Cells(Rows.Count, "C").End(3))
    '// End(3) 은 End(xlUp), 데이터가 있는 마지막행까지 자동으로 찾음

    FindText = InputBox("검색할 문자를 ,로 분리하여 입력(최대 3개)") '//검색할 문자를 변수에 넣음
    Dim V As Variant
    V = Split(FindText, ",")
    If UBound(V) > 2 Then MsgBox "최대 3개의 단어만 지원합니다.": End
   
    With rngTarget
        .Font.Bold = False
        .Font.ColorIndex = xlAutomatic
        Dim i As Integer
        For i = 0 To UBound(V)
            Set C = .Find(what:=V(i), lookat:=xlPart)
           
            If Not C Is Nothing Then
                strAddr = C.Address '// 찾은 셀의 주소를 변수에 넣음
                Do
                    S = 1
                    Do
                        With C.Characters(Start:=InStr(S, C, V(i)), Length:=Len(V(i))).Font
                        '.Bold = True   '// 굵은 글씨로 표시하고 싶으면
                        .Color = Choose(i + 1, vbBlue, vbRed, vbGreen) '// 글자색 표시, vbGreen 녹색 vbRed 빨간색
                        End With
                        S = S + InStr(S, C, V(i))
                    Loop While InStr(S, C, V(i))
                    Set C = .FindNext(C) '// 다음 찾은 데이터를 변수에
                Loop While Not C Is Nothing And strAddr <> C.Address
                '// 검색 일치하지 않거나 처음 찾은 셀이 아닐때까지 무한 반복
            End If
        Next
    End With
   
    Set rngTarget = Nothing '// 변수 초기화
End Sub

728x90
블로그 이미지

Link2Me

,