[땡큐엑셀vba & 엑셀매크로] 단어카운트(Transpose,Dictionary)

 

'http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=283562551
'
'예를 들면
'A1 셀에 FREE NOTE 라고 적혀있고
'A2 셀에 FREE SIZE 라고 적혀있을 때
'다른 셀에 두 셀의 내용 중 중복되는 단어는 FREE라고 나오거나
'또는 이 FREE 라는 단어가 몇 번 중복되었는지 출력할 수 있는 함수가 있을까요?
'조건부 서식으로는 불가능합니다.

'
'source by 땡큐엑셀vba & 엑셀매크로
'
Sub 단어카운트()

    Dim D As Object
    Dim v범위
    
    
    v범위 = Selection
    
    
    'i:j열 클리어
    Range("i:j").Clear
    
    '화면갱신 중지
    Application.ScreenUpdating = False
    
    
    '1. 범위를 루프돌며 사전에 기록
    Set D = CreateObject("Scripting.Dictionary")    '딕셔너리 선언
    
    
    '파싱
    For Each r In Selection
    
        '널이 아닌셀만
        If r <> "" Then
        
            'Split함수를 사용하여 공백으로 단어 분리
            v범위 = Application.Transpose(Split(r, " ")) '행,열 변환
        
            iCnt = UBound(v범위, 1)
            Select Case iCnt
                Case 1: '1개 단어일 경우
                    If Not D.exists(v범위(iCnt)) Then
                        '처음출현하는 단어
                        D.Add v범위(iCnt), 1
                    Else
                        '재출현하는 단어는 +1
                        D.Item(v범위(iCnt)) = D.Item(v범위(iCnt)) + 1
                    End If
                
                
                Case Else '2개 이상의 단어일경우
                
                     For i = 1 To UBound(v범위, 1)
                        If Not D.exists(v범위(i, 1)) Then
                            '처음출현하는 단어
                            D.Add v범위(i, 1), 1
                        Else
                            '재출현하는 단어는 +1
                            D.Item(v범위(i, 1)) = D.Item(v범위(i, 1)) + 1
                        End If
                    Next
            
            End Select
            
            


        End If
        
    
    Next
    
    
    
    
    '출력
    Dim key As Variant
    j = 1
    For Each key In D.Keys
        Cells(j, "I") = key
        Cells(j, "J") = D(key)
        
        j = j + 1
        'Debug.Print key, dict(key)
    Next key
    
    
    '화면 갱신 재계
    Application.ScreenUpdating = True
    
    
    MsgBox "완료되었습니다.", vbInformation, "땡큐엑셀vba & 엑셀매크로"
    
End Sub

 

단어카운트-Dictionary_Transpose_Split-땡큐엑셀vba.xlsm

0.06MB