단어의 빈도수 통계내기

 

 

Dictionary 를 이용해서 단어의 빈도수 통계를 내볼 수 있습니다.

​

Sheet1 에 아래와 같이 텍스트가 들어 있습니다.

​

Alt+F8로 CountWords 매크로를 실행하면 아래처럼 각 단어의 빈도수를 Sheet2 에 알려줍니다.

​

코드는 아래와 같습니다.

Alt+F11 창 도구 > 참조에서 Microsoft SCripting Runtime 라이브러리를 체크해주세요.

Option Explicit
Sub CountWords()

    Dim sht1 As Worksheet, sht2 As Worksheet
    Dim rng As Range
    '도구-참조에서 Microsoft Scripting Runtime 체크 필수
    Dim d As Dictionary
    'Dim d as Object
    'Set d = CreateObject("Scripting.Dictionary")
    Dim c As String
    Dim i%, tmp$(), s$
    
    Set sht1 = Sheet1
    Set sht2 = Sheet2
    Set d = New Dictionary
   
    
    For Each rng In sht1.UsedRange
        tmp = Split(Trim(rng.Text), " ")
        For i = LBound(tmp) To UBound(tmp)
            s = removeTail(tmp(i))
            If d.Exists(s) Then
                d(s) = d(s) + 1
            Else
                d.Add s, 1
            End If
        Next i
    Next rng
    
    SortDict d
    
    sht2.Cells.ClearContents
    For i = 0 To d.Count - 1
        sht2.Cells(i + 1, "A") = d.Keys(i)
        sht2.Cells(i + 1, "B") = d.Items(i)
    Next i
    sht2.Columns.AutoFit
    
    Set d = Nothing

End Sub

'어미나 문장부호 떼어버리기
Function removeTail(str As String) As String
    Dim tail() As Variant
    Dim t As String, lent As Integer, i As Integer
    
    'tail = Array("가", "은", "는", "을", "를", "와", "에", "에서", "로", "으로", ",", "!", "?", ".")
    tail = Array("을", "를", ",", "!", "?", ".")

    str = Trim(str)
    For i = LBound(tail) To UBound(tail)
        t = tail(i)
        lent = Len(t)
        If t = Right(str, lent) Then
            str = Left(str, Len(str) - lent)
            removeTail = str
            Exit For
        End If
    Next i
    removeTail = str
End Function

Function SortDict(ByRef dic As Scripting.Dictionary)
    Dim i As Long
    Dim j As Long
    Dim tmp  As String
    Dim arr() As String
    Dim tmpdic As Scripting.Dictionary
    ' Get out if dictionary is empty
    If dic Is Nothing Then
        Exit Function
    End If
    ' or if it has at most one item
    If dic.Count <= 1 Then
        Exit Function
    End If
    ' Fill arrays with arr
    ReDim arr(0 To dic.Count - 1)
    For i = 0 To dic.Count - 1
        arr(i) = dic.Keys(i)
    Next i
    ' Sort the array
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If dic(arr(i)) < dic(arr(j)) Then
                tmp = arr(i)
                arr(i) = arr(j)
                arr(j) = tmp
            End If
        Next j
    Next i
    ' Fill new dictionary with the sorted keys
    Set tmpdic = New Scripting.Dictionary
    For i = 0 To dic.Count - 1
        tmpdic.Add Key:=arr(i), Item:=dic(arr(i))
    Next i
    ' Set original dictionary to temp one
    Set dic = tmpdic
End Function

 

'을, 를'이나 문장 부호는 제외하고 있습니다.

이 부분은 좀 더 튜닝이 필요합니다.

​

첨부파일 참고 하세요.

 

단어빈도수1.xlsm

0.03MB

 

 

참고: 지식인