Function ReplaceDouble _
         (ByVal Text As String, ByRef Such As String, _
                         suchArt As VbCompareMethod) As String
 
        ' TKurz = ReplaceDouble("abBbcbbb", "b", vbTextCompare)
        ' entfernt so doppelte "b" aber auch "bB" -> "abcb"
 
        ' TKurz = ReplaceDouble(" b   bb", " ", vbBinaryCompare)
        ' entfernt so doppelte " " -> " b bb"
 
         Dim DoppelSuch As String
 
         If LenB(Such) > 0 Then
 
            DoppelSuch = Such + Such
 
            Do While InStr(1, Text, DoppelSuch, suchArt) > 0
               Text = Replace(Text, DoppelSuch, Such, 1, -1, suchArt)
            Loop
 
         End If
 
         ReplaceDouble = Text
End Function
 
 
Sub ReplaceDoubleSub _
   (ByRef Text As String, ByRef Such As String, suchArt As VbCompareMethod)
 
        ' Aufruf als Sub geht oft etwas schneller 
        ' T = "abBbcbbb" : ReplaceDoubleSub T, "b", vbTextCompare
        ' entfernt so doppelte "b" aber auch "bB" -> "abcb"
 
        ' T = " b   bb"  : ReplaceDoubleSub T, " ", vbBinaryCompare
        ' entfernt so doppelte " " -> " b bb"
 
         Dim DoppelSuch As String
 
         If LenB(Such) > 0 Then
 
            DoppelSuch = Such + Such
 
            Do While InStr(1, Text, DoppelSuch, suchArt) > 0
               Text = Replace(Text, DoppelSuch, Such, 1, -1, suchArt)
            Loop
 
         End If
 
End Sub