این هم کد تابع :
برای دریافت نمونه فایل حاوی تابع به فایل پیوست این مقاله مراجعه کنید.
Function WordCount(tbl_array As Range, pos As Integer) As Variant()
Dim cell As Variant, wrds As Variant, i As Integer
Dim a As Integer, j As Integer
Dim tmp() As String, nr() As Integer
ReDim tmp(0), nr(0)
nr(0) = 1
For Each cell In tbl_array
wrds = Split(cell)
For i = 0 To UBound(wrds)
For j = 0 To UBound(tmp)
If wrds(i) = tmp(j) Then
nr(j) = nr(j) + 1
a = 1
Exit For
End If
Next j
If a 1 Then
tmp(UBound(tmp)) = wrds(i)
ReDim Preserve tmp(UBound(tmp) + 1)
ReDim Preserve nr(UBound(tmp))
nr(UBound(tmp)) = 1
End If
a = 0
Next i
Next cell
If pos = 1 Then
ReDim Preserve tmp(UBound(tmp) - 1)
WordCount = Application.Transpose(tmp)
Else
ReDim Preserve nr(UBound(nr) - 1)
WordCount = Application.Transpose(nr)
End If
End Function
