728x90

찾고자 하는 단어 전부 찾는 VBA


엑셀을 다루다보면 셀에 포함된 단어를 찾아야 할 경우가 있습니다.


FindVBA.vbs


Sub Character_Find()

    Dim rngC As Range

    Dim rngAll As Range '//대상 범위 지정변수

    Dim FindText As String

    Dim strAddr As String

    Dim S As Integer

    

    Application.ScreenUpdating = False  '//화면 업데이트 일시 정지

    'Set rngAll = ActiveSheet.UsedRange

    Set rngAll = Range([C3], Cells(Rows.Count, "C").End(3))

    '// End(3) 은 End(xlUp), 데이터가 있는 마지막행까지 자동으로 찾음

       

    FindText = InputBox("검색할 문자 입력") '//검색할 문자를 변수에 넣음

    If FindText = "" Then Exit Sub           '// 취소 선택시 매크로 중단

    Range([F3], Cells(Rows.Count, "F").End(3)).ClearContents  '// 찾는 값을 기록한 열을 초기화

            

    With rngAll

        .Font.Bold = False

        .Font.ColorIndex = xlAutomatic

        Set rngC = .Find(what:=FindText, lookat:=xlPart)

                

        If Not rngC Is Nothing Then

            strAddr = rngC.Address '// 찾은 셀의 주소를 변수에 넣음

            Do

                S = 1

                Do

                    With rngC.Characters(Start:=InStr(S, rngC, FindText), Length:=Len(FindText)).Font

                    '.Bold = True   '// 굵은 글씨로 표시하고 싶으면

                    .Color = vbBlue '// 글자색 표시, vbGreen 녹색 vbRed 빨간색

                    End With

                    

                    rngC.Offset(0, 3) = FindText

                    S = InStr(S, rngC, FindText) + Len(FindText)

                Loop While InStr(S, rngC, FindText)

                Set rngC = .FindNext(rngC) '// 다음 찾은 데이터를 변수에

            Loop While Not rngC Is Nothing And strAddr <> rngC.Address

            '// 검색 일치하지 않거나 처음 찾은 셀이 아닐때까지 무한 반복

        End If

    End With

    

    Set rngAll = Nothing '// 변수 초기화

End Sub

블로그 이미지

Link2Me

,