Woorden tellen in een bereik

[willema]

Dag allemaal,

deze heb ik ergens op het internet gevonden :

Sub CountWords()

   Dim WordCount As Long
   Dim Rng As Range
   Dim S As String
   Dim N As Long

   For Each Rng In ActiveSheet.UsedRange.Cells
      S = Application.WorksheetFunction.Trim(Rng.Text)
      N = 0
      If S <> vbNullString Then
         N = Len(S) - Len(Replace(S, " ", "")) + 1
      End If
      WordCount = WordCount + N
   Next Rng

   MsgBox "Words In ActiveSheet Sheet: " & Format(WordCount,"#,##0")

End Sub

Nu lukt het me niet echt om er een functie van te maken.
Bedoeling is om in een procedure het totaal aantal woorden te tellen in één of meerdere cellen van een bereik om dan verder te werken met die waarde.
Dus in de procedure staat dan:

CountWords(Range(Cells(2,4),Cells(x,4)))
'bereik is altijd in kolom D, startend vanaf cel D2 tot de rij die met variabele x wordt gedefinieerd.
MsgBox "Er zijn " & CountWords & " woorden gevonden in het bereik."

De functie is dan iets als:

Function CountWords(Rng As Range) As Long

   ...
   'met hiertussen iets dat lijkt op bovenstaande code

End Function

Wie zet me op het juiste pad ?
Met dank,

Marnik

 

[HSV]

Bv.

Function CountWords(rng As Range) As Long
Dim WordCount As Long, cl As Range
  For Each cl In rng
    WordCount = WordCount + UBound(Split(Trim(cl))) + 1
  Next cl
 CountWords = WordCount
End Function

Met in de cel bv: =countwords(a1:e10)

 

[pasan]

ietsje anders

Function CountWords(Rng As Range) As Long
 For Each c In Rng
  If c <> "" Then T = Trim(T) & " " & Trim(c)
 Next
CountWords = Len(T) - Len(Replace(T, " ", "")) + 1
End Function

 

[MDN111]

Hallo !

Ik dacht "weinig reactie, dus ik ga eens op zoek..." en net toen ik m'n antwoord wilde posten was daar de code van HSV al. Niettegenstaande de code van HSV absoluut b-e-a-u-t-i-f-u-l :thumb: is, post ik toch m'n antwoord. Deze code is een stuk minder elegant, maar anders was de moeite voor niets.

Function CountWords(rng As Range) As Long
Dim oC As Range, S As String, n As Long
For Each oC In rng
    S = Trim(oC.Text)
    n = 0
    If S <> vbNullString Then
        n = Len(S) - Len(Replace(S, " ", "")) + 1
    End If
    CountWords = CountWords + n
Next
End Function

Hierna nog enkele inspiratiebronnen:

http://www.extendoffice.com/documents/excel/933-excel-count-words.html
http://www.excel-easy.com/vba/examples/count-words.html
http://www.cpearson.com/excel/wordcount.htm

Grtz,
MDN111.

P.S. Ondertussen was er ook nog de code van pasan bijgekomen, met nòg een regel minder. Briljant :thumb:

 

[willema]

Dankjewel voor jullie massale reacties :thumb:

Ik ga aan de slag met al jullie voorstellen. Zo leer ik ook wat uit de onderlinge verschillen.
Ik neem aan dat de ideale oplossing voor mij hier ergens tussen staat, dus geef ik deze vraag alvast de status "opgelost".

Groetjes,
Marnik