범위 내의 셀 내의 단어의 빈도

Question

나는 약 50 개의 셀로 구성되어 있습니다. 각 셀은 3-8 문장의 텍스트 블록을 포함합니다.

Id는 사용되는 단어 목록을 채우고 전체 범위 (A1 : A50)에 대한 빈도를 얻으려고합니다.

필자는 다른 게시물에서 발견 한 다른 코드를 조작하려고 시도했지만 여러 단어가 아닌 하나의 단어가 포함 된 셀에 맞게 조정 된 것처럼 보입니다.

이것은 내가 사용하려고 시도했던 코드입니다.

Sub Ftable() 
Dim BigString As String, I As Long, J As Long, K As Long 
Dim Selection As Range 

Set Selection = ThisWorkbook.Sheets("Sheet1").Columns("A") 
BigString = "" 
For Each r In Selection 
    BigString = BigString & " " & r.Value 
Next r 
BigString = Trim(BigString) 
ary = Split(BigString, " ") 
Dim cl As Collection 
Set cl = New Collection 
For Each a In ary 
    On Error Resume Next 
    cl.Add a, CStr(a) 
Next a 

For I = 1 To cl.Count 
    v = cl(I) 
    ThisWorkbook.Sheets("Sheet2").Cells(I, "B").Value = v 
    J = 0 
    For Each a In ary 
     If a = v Then J = J + 1 
    Next a 
    ThisWorkbook.Sheets("Sheet2").Cells(I, "C") = J 
Next I 
End Sub 

Answer 1

(로렘 입숨 텍스트의 일부 긴 블록으로 나를 위해 작품)이 시도 : 모든 반대

Sub Ftable() 
Dim BigString As String, I As Long, J As Long, K As Long 
Dim countRange As Range 

Set countRange = ThisWorkbook.Sheets("Sheet1").Range("A1:A50") 
BigString = "" 
For Each r In countRange.Cells 
    BigString = BigString & " " & r.Value 
Next r 
BigString = Trim(BigString) 
ary = Split(BigString, " ") 
Dim cl As Collection 
Set cl = New Collection 
For Each a In ary 
    On Error Resume Next 
    cl.Add a, CStr(a) 
Next a 

For I = 1 To cl.Count 
    v = cl(I) 
    ThisWorkbook.Sheets("Sheet2").Cells(I, "B").Value = v 
    J = 0 
    For Each a In ary 
     If a = v Then J = J + 1 
    Next a 
    ThisWorkbook.Sheets("Sheet2").Cells(I, "C") = J 
Next I 
End Sub 

나는, 단지 당신이 데이터를 50 세포에서보고 내려 갔다 그 칼럼에서 1 백만이 넘습니다. 또한 r이 Range 대신 길이 1 배열을 얻는 문제를 수정했습니다. Selection이 이미 응용 프로그램에 정의되어 있으므로 "Selection"의 이름을 "countRange"로 변경했기 때문에 이름이 잘못되었습니다.

또한 "Sheet1"에서 코드를 가져 와서 "Sheet2"의 B 및 C 열로 출력합니다. 워크 시트의 이름을 바꾸거나이 값을 편집했는지 확인하십시오. 그렇지 않으면 오류/데이터 손상이 발생합니다.

---

이 내가 문제를 접근하는 것 방법입니다

Sub Ftable() 
Dim wordDict As New Dictionary 
Dim r As Range 
Dim countRange As Range 
Dim str As Variant 
Dim strArray() As String 

Set countRange = ThisWorkbook.Sheets("Sheet1").Range("A1:A50") 

For Each r In countRange 
    strArray = Split(Trim(r.Value), " ") 

    For Each str In strArray 
     str = LCase(str) 
     If wordDict.Exists(str) Then 
      wordDict(str) = wordDict(str) + 1 
     Else 
      wordDict.Add str, 1 
     End If 
    Next str 
Next r 

Set r = ThisWorkbook.Sheets("Sheet2").Range("B1") 
For Each str In wordDict.Keys() 
    r.Value = str 
    r.Offset(0, 1).Value = wordDict(str) 
    Set r = r.Offset(1, 0) 
Next str 

Set wordDict = Nothing 
End Sub 

그것은 사전을 사용을, 그래서 당신은 라이브러리에 대한 참조를 추가해야합니다 (참조 도구> 추가> 마이크로 소프트 스크립트 라이브러리). 또한 모든 것을 소문자로 강제합니다. 이전 코드의 큰 문제점 중 하나는 대문자 및 소문자가없는 버전을 올바르게 계산하지 못했기 때문에 많은 단어를 놓쳤다는 것입니다. 이 항목을 원하지 않으면 str = LCase(str)을 삭제하십시오.

보너스 :이 방법은 테스트 시트에서 약 8 배 빠릅니다.

Answer 2

여기에 가서 사전이 이미 항목이 포함되어 있는지 테스트 할 수 있으므로이 문제를 처리하는 가장 좋은 방법이라고 생각합니다. 당신이 얻지 못하는 것이 있으면 다시 게시하십시오.

Sub CountWords() 

Dim dictionary As Object 
Dim sentence() As String 
Dim arrayPos As Integer 
Dim lastRow, rowCounter As Long 
Dim ws, destination As Worksheet 

Set ws = Sheets("Put the source sheet name here") 
Set destination = Sheets("Put the destination sheet name here") 

rowCounter = 2 
arrayPos = 0 
lastRow = ws.Range("A1000000").End(xlUp).Row 

Set dictionary = CreateObject("Scripting.dictionary") 

For x = 2 To lastRow 
    sentence = Split(ws.Cells(x, 1), " ") 
    For y = 0 To UBound(sentence) 
     If Not dictionary.Exists(sentence(y)) Then 
      dictionary.Add sentence(y), 1 
     Else 
      dictionary.Item(sentence(y)) = dictionary.Item(sentence(y)) + 1 
     End If 
    Next y 
Next x 

For Each Item In dictionary 
    destination.Cells(rowCounter, 1) = Item 
    destination.Cells(rowCounter, 2) = dictionary.Item(Item) 
    rowCounter = rowCounter + 1 
Next Item 

End Sub