Genarating count of unique words in a cell or cells
Try this. Requires a reference to the Scripting runtime library.
Tim.
Sub tester()
ActiveSheet.Range("B1").Value =
CountWords(ActiveSheet.Range("A1").Value)
End Sub
Function CountWords(sText As String) As String
Dim x As Integer
Dim arrWords As Variant
Dim arrReplace As Variant
Dim oDict As New Scripting.Dictionary
Dim tmp As String
Dim k As Variant
Dim sReturn As String
arrReplace = Array(vbTab, ":", ";", ".", Chr(10), Chr(13))
For x = LBound(arrReplace) To UBound(arrReplace)
sText = Replace(sText, arrReplace(x), " ")
Next x
arrWords = Split(sText, " ")
oDict.CompareMode = TextCompare 'case-insensitive
For x = LBound(arrWords) To UBound(arrWords)
tmp = Trim(arrWords(x))
If tmp < "" Then
oDict(tmp) = IIf(oDict.Exists(tmp), oDict(tmp) + 1, 1)
End If
Next x
sReturn = ""
For Each k In oDict.Keys
sReturn = sReturn & "{" & k & "} : " & oDict(k) & Chr(10)
Next k
CountWords = sReturn
End Function
Tim.
"Hari" wrote in message
...
Hi,
Suppose in cell A1 I have a text --- "I had some bread in morning.
I had
some eggs at night."
Is it possible to programmatically get a count of unique words in
the above
string.
Like in column B the unique words are listed one word in each row
in the
following manner..B1 -- "I"
B2 -- "I
B2 -- "had
B3 -- "some"
B4 -- "bread"
B5 -- "in"
B6 -- "morning"
B7 -- "eggs"
B8 -- "at"
B9 -- "night"
Actually I can use excel's text to columns feature ( using space as
a
delimiter) but automating is a problem. Like I have 500 or so rows
of data
and out of those rows I want to get count of unique words within
those 500
rows ( basically a consolidated unique list..). Now, each row would
be
having different number of words so, programmatically how would it
be
implemented.
Please guide me if possible.
Regards,
Hari
India
|