Hamburg (amtlich Freie und Hansestadt Hamburg (niederdeutsch Friee un Hansestadt Hamborg, Ländercode: HH), ist als Stadtstaat ein Land der Bundesrepublik Deutschland. Der amtliche Name verweist auf die Geschichte Hamburgs als Freie Reichsstadt und als führendes Mitglied des Handelsbundes der Hanse.
Hamburg ist mit ca. 1,9 Millionen Einwohnern die zweitgrößte Stadt Deutschlands und die drittgrößte im deutschen Sprachraum. Das Stadtgebiet ist in sieben Bezirke und 104 Stadtteile gegliedert, darunter mit dem Stadtteil Neuwerk eine in der Nordsee gelegene Inselgruppe.
Anmerkung: Der Beispieltext hat Rechtschreibfehler: (aufgrund Einscannen (OCR)?)
Option Explicit
Sub Test_AllInOne()
Dim rngWord As Word.Range
Dim rngLaengste As Word.Range
Dim dic As Object 'Scripting.Dictionary
Dim nGrossb As Long
'Formatierung aus vorherigen Durchgang rückgängig machen
ThisDocument.Range.Font.Reset
ThisDocument.Range.HighlightColorIndex = wdAuto
'hiermit merken wir uns wie oft ein Wort vorkommt (und auch wo im Text)
' dic
' + Item("Hamburg") : Scripting.Dictionary-Objekt
' + #0: Objekt : Word.Range-Objekt
' + #1: Objekt : Word.Range-Objekt
' + #2: Objekt : Word.Range-Objekt
' + Item("amtlich") : Scripting.Dictionary-Objekt
' + #0: Objekt : Word.Range-Objekt
' usw.
Set dic = CreateObject("Scripting.Dictionary")
'wir unterscheiden Groß-/Kleinschreibung (z.B. 'A' ungleich 'a')
dic.CompareMode = VbCompareMethod.vbBinaryCompare
'Wortweise durch den Text bewegen
For Each rngWord In ThisDocument.Words
'Leerzeichen am Ende eines Wortes weglassen - seltsames Verhalten von Word ¯\_('-')_/¯
rngWord.MoveEndWhile " ", wdBackward
'Kommas, Klammern, usw. interessieren uns hier nicht
If IsWord(rngWord.Text) Then
'#1: Anzahl der Großbuchstaben zählen
nGrossb = nGrossb + AnzGrossbuchstaben(rngWord.Text)
'#2: hier merken wir uns das längste Wort in einem Word.Range-Objekt
If rngLaengste Is Nothing Then
Set rngLaengste = rngWord
' Debug.Print Len(rngWord), rngWord.Text
ElseIf Len(rngWord.Text) > Len(rngLaengste.Text) Then
Set rngLaengste = rngWord
' Debug.Print Len(rngWord), rngWord.Text
End If
'#3: alle Worte merken - Wort-Liste (siehe oben)
If Not dic.Exists(rngWord.Text) Then
'neues Wort aufnehmen (siehe oben)
Call dic.Add(rngWord.Text, CreateObject("Scripting.Dictionary"))
With dic(rngWord.Text)
Call .Add(.Count, rngWord)
End With
Else
'bereits bekanntes Wort in Liste -> Word.Range merken
With dic(rngWord.Text)
Call .Add(.Count, rngWord)
End With
End If
End If 'IsWord()
Next 'rngWord
'#1: Anzahl der Großbuchstaben ausgeben
Call MsgBox("Anzahl Großbuchstaben: " & nGrossb, vbInformation)
'#2: längstes Wort im Text markieren
With rngLaengste
.HighlightColorIndex = WdColorIndex.wdRed
.Font.ColorIndex = WdColorIndex.wdWhite
End With
'#3 Häufigstes vorkommen ermitteln (Wort-Liste mit größter Anzahl an Word.Range-Objekten)
Dim vntElem As Variant
Dim strKey As String
Dim n As Long
For Each vntElem In dic
' Debug.Print dic(vntElem).Count, vntElem
If dic(vntElem).Count > n Then
n = dic(vntElem).Count
strKey = vntElem
End If
Next
If strKey <> "" Then
With dic(strKey)
'vntElem ist ein Word.Range-Objekt
For Each vntElem In .Items()
vntElem.HighlightColorIndex = WdColorIndex.wdGreen
vntElem.Font.ColorIndex = WdColorIndex.wdWhite
Next
End With
End If
End Sub
Private Function IsWord(Word As String) As Boolean
Dim blnFlag As Boolean
Dim strChr As String * 1
Dim i As Long
blnFlag = True
For i = 1 To Len(Word)
strChr = Mid$(Word, i, 1)
Select Case LCase$(strChr)
Case "a" To "z", "ä", "ö", "ü", "ß"
'ok
Case Else
blnFlag = False
Exit For
End Select
Next
IsWord = blnFlag
End Function
'Hilfsfunktion
' - Alternative mit Mid()- und InStr()-Funktion
' stellt fest wie kompliziert/komplex ein Wort ist
Private Function AnzGrossbuchstaben(Wort As String) As Long
Dim strChr As String * 1
Dim i As Long
Dim n As Long
For i = 1 To Len(Wort)
strChr = Mid$(Wort, i, 1)
Select Case strChr
Case "A" To "Z", "Ä", "Ö", "Ü"
n = n + 1
End Select
Next
AnzGrossbuchstaben = n
End Function
|