엑셀로 정리된 많은 양의 녹취 목록에서 특정 단어를 선택하여 분류하는 작업을 엑셀로 진행했습니다.
특정 단어에 색을 칠하고, 중복을 제거하여 단어 목록을 뽑아야 하는데요.
이를 수작업으로 진행하려니 너무 힘들어서 엑셀의 매크로 기능을 사용해 보았습니다.
1. 매크로 개발
- alt + F11
- 좌측 폴더에서 우클릭 > 추가 > 모듈
- 아래의 Visual Basic 입력
' 셀을 선택후 문자를 입력하면 해당 색깔을 빨간색으로 변경함
' 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 선택
- 텍스트 입력창에 원하는 단어를 입력
- 중지 하고 싶으면 취소를 선택
3. 마킹된 단어를 추출
- 원하는 셀선택 (A2 ~ A4)
- 보기 > 매크로 > PaintWordToRed 선택
4. 중복 제거 및 정렬
- 원하는 셀(B2) 우측셀에서 =TxtSort(B2,”,”) 입력












