| |
---------------------------------
'파일 첨부합니다
'---------------------------------
'---------------------------------
Sub search_and_color_move()
'---------------------------------
Dim search As String
'찾을 글자
search = InputBox("찾아서 글자의 색상을 바꿀 단어를 입력하십시오!")
If Len(search) = 0 Then Exit Sub '아무 값 입력이 없으면 종료
Application.ScreenUpdating = False
'찾을 범위 지정
Dim rngX As Range: Set rngX = Range("B4", Cells(Rows.Count, "B").End(xlUp))
Dim cell As Range, sCell As String
Dim iIndex As Long:
'찾는 값 길이
Dim iLen As Long: iLen = VBA.Len(search)
Dim blnSearch As Boolean
' Sheet2 초기화
Dim rng As Range: Set rng = Application.Worksheets("Sheet2").Range("B2")
rng.CurrentRegion.ClearContents
rng.Value = "추출 결과"
For Each cell In rngX.Cells ' 각 셀을 돌며
sCell = cell.Value
iIndex = 1
If Len(sCell) <> 0 Then ' 빈셀이 아니면
cell.Font.ColorIndex = XlColorIndex.xlColorIndexAutomatic ' 글자 색 초기화-깜장색
blnSearch = False ' 찾았음을 확인하기 위한 불린값
Do While iIndex > 0
iIndex = VBA.InStr(iIndex, sCell, search) ' 해당 글자 위치(인덱스 찾기)
If iIndex = 0 Then Exit Do ' 못 찾으면 빠져나가기, inStr함수는 못 찾으면 0을 밷어냄.
' 찾았으면
'-----------------------------------------------------
blnSearch = True
cell.Characters(iIndex, iLen).Font.ColorIndex = 3 '빨강
iIndex = iIndex + iLen ' 다음 찾기를 위해 index값을 늘려 줌.
'-----------------------------------------------------
Loop
' 셀 복사
If blnSearch Then copyCell cell
End If
Next cell
Application.ScreenUpdating = True
End Sub
'---------------------------------
Sub copyCell(cell As Range)
'---------------------------------
Dim rng As Range: Set rng = Application.Worksheets("Sheet2").Range("B3")
' Set rng = IIf(VBA.IsEmpty(rng), rng, rng.Offset(-1, 0).End(xlDown).Offset(1, 0))
cell.Copy Worksheets("Sheet2").Cells(1000, 2).End(xlUp).Offset(1)
End Sub
|
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
