Option Explicit
Sub ZuFussZählen()
'Wörter sind Texte
Dim rng As Excel.Range, c As Excel.Range, rw As Excel.Range, rc As Excel.Range
Dim Content As String, ArrCont() As String
Dim Zahl As Long, x As Long
'
'testfilter
Set rng = Range("$A$14:$G$645")
rng.AutoFilter
rng.AutoFilter Field:=5, Criteria1:="1"
rng.AutoFilter Field:=6, Criteria1:="0"
'testezeilen
For Each rw In rng.Rows
If Not rw.Hidden Then
'testzellen
For Each rc In rw.Cells
If Not rc.HasFormula And VarType(rc) = 8 Then
Content = Trim(rc.Value)
Content = Replace(Content, " ", ",")
'testfelder
ArrCont = Split(Content, ",")
For x = LBound(ArrCont) To UBound(ArrCont)
'testcount
If Len(ArrCont(x)) > 0 Then Zahl = Zahl + 1
Next x
End If
Next rc
End If
Next rw
'****************************************
Call MsgBox(Format(Zahl, "#0"), vbInformation, "Anzahl Worte")
rng.AutoFilter
End Sub
|