엑셀 매크로 – 단어 마킹,선택,중복제거

엑셀로 정리된 많은 양의 녹취 목록에서 특정 단어를 선택하여 분류하는 작업을 엑셀로 진행했습니다.
특정 단어에 색을 칠하고, 중복을 제거하여 단어 목록을 뽑아야 하는데요.
이를 수작업으로 진행하려니 너무 힘들어서 엑셀의 매크로 기능을 사용해 보았습니다.

1. 매크로 개발

  • alt + F11
  • 좌측 폴더에서 우클릭 > 추가 > 모듈
  • 아래의 Visual Basic 입력

xlsm_006

xlsm_005

' 셀을 선택후 문자를 입력하면 해당 색깔을 빨간색으로 변경함
' http://unikys.tistory.com/307
Sub PaintWordToRed()
    Dim cell As Range, word As String, startIndex As Integer
    word = InputBox(Prompt:="단어를 입력하세요", Title:="문자열 색 변환")
        
    While Len(word) > 0
        For Each cell In Selection
            startIndex = InStr(1, cell.Value, word)
            While startIndex <> 0
                If startIndex > 0 Then
                    cell.Characters(startIndex, Len(word)).Font.Color = RGB(255, 0, 0)
                    Rem cell.Characters(startIndex, Len(word)).Font.Bold = True
                    startIndex = InStr(startIndex + 1, cell.Value, word)
                End If
            Wend
        Next cell
        
        word = InputBox(Prompt:="단어를 입력하세요", Title:="문자열 색 변환")
    Wend
End Sub


'선택된 셀의 빨간색 단어들을 컴마로 구분하여 우측셀에 문자열로 생성한다.
Sub CopyRedWordToRight()
    Dim currentIndex As Integer
    Dim lastIndex As Integer
    Dim words As String
    Dim isPrevRed As Boolean

    ' 선택된 셀을 돌면서 빨간색을 추출하여 words에 넣는다.
    For Each cell In Selection
    
        currentIndex = 1
        lastIndex = Len(cell)
        words = ""
        isPrevRed = False

        ' 한글자씩 빨간색인지 검사하여 words에 추가
        While currentIndex <= lastIndex
            If cell.Characters(currentIndex, 1).Font.Color = RGB(255, 0, 0) Then
                words = words + Mid(cell.Value, currentIndex, 1)
                isPrevRed = True
            Else
                If isPrevRed = True Then
                    words = words + ","
                End If
                    isPrevRed = False
            End If
            
            currentIndex = currentIndex + 1
        Wend
        
        ' 마지막에 , 가 있으면 삭제
        If words <> "" Then
            If Mid(words, Len(words), 1) = "," Then
                words = Mid(words, 1, Len(words) - 1)
            End If
        End If
        
        '오른쪽 셀에 복사하여 넣기
        Cells(cell.Row, cell.Column + 1).Value = words
    Next cell
End Sub


' 구분자를 기준으로 정렬 및 중복제거를 수행한다.
' http://dium0114.tistory.com/30
Function TxtSort(strR As Variant, strC As Variant) As Variant

    'strR 은 정렬을 할 셀 선택
    'strC 는 셀 구분자를 입력
    
    Dim NC          As New Collection
    Dim strTxt      As Variant
    Dim temp        As Variant
    Dim cnt         As Integer
    Dim i           As Integer
    Dim j           As Integer
    
    cnt = (Len(strR) - Len(Application.WorksheetFunction.Substitute(strR, strC, ""))) / Len(strC)
    
    ReDim strTxt(1 To cnt + 1)
    
    For i = 1 To cnt
        strTxt(i) = Left(strR, InStr(1, strR, strC) - 1)
        strR = Mid(strR, Len(strTxt(i)) + Len(strC) + 1, Len(strR) - (Len(strTxt(i)) + Len(strC)))
    Next i
    
    strTxt(cnt + 1) = strR
    
    On Error Resume Next
    cnt = cnt + 1
    For i = 1 To cnt
        NC.Add strTxt(i), strTxt(i)
    Next i
    On Error GoTo 0
    
    ReDim temp(NC.Count)
    
    cnt = NC.Count
    
    For i = 1 To cnt
        For j = 1 To cnt
            If NC(i) >= NC(j) Then
                temp(i) = temp(i) + 1
            End If
        Next j
    Next i
    
    ReDim strTxt(NC.Count)
    For i = 1 To cnt
        strTxt(temp(i)) = NC(i)
    Next
    
    strR = strTxt(1)
    
    For i = 2 To cnt
        strR = strR & strC & strTxt(i)
    Next

    TxtSort = strR

End Function

 

2. 특정 단어를 빨간색으로 마킹

  • 원하는 셀선택 (A2 ~ A4)
  • 보기 > 매크로 > PaintWordToRed 선택
  • 텍스트 입력창에 원하는 단어를 입력
  • 중지 하고 싶으면 취소를 선택

xlsm_001

xlsm_002

3. 마킹된 단어를 추출

  • 원하는 셀선택 (A2 ~ A4)
  • 보기 > 매크로 > PaintWordToRed 선택

xlsm_003

4. 중복 제거 및 정렬

  • 원하는 셀(B2) 우측셀에서 =TxtSort(B2,”,”) 입력

xlsm_004

6. 첨부파일

예제 Download

5. 참고한 URL

댓글 남기기