Function TB(ByVal txt$, ByVal part1$, ByVal part2$, ByVal sep$)
    On Error Resume Next
    Dim Arr, i, res$
    Select Case ""
        Case part1$ & part2$: TB = txt: Exit Function
        Case part1$: Arr = Split(txt, part2$): Arr(UBound(Arr)) = ""
        Case part2$: Arr = Split(txt, part1$): Arr(0) = ""
        Case Else: Arr = Split(txt, part1$)
            Arr(0) = ""
            For i = LBound(Arr) To UBound(Arr)
                If InStr(1, Arr(i), part2$, vbTextCompare) Then
                Arr(i) = Split(Arr(i), part2$)(0)
                End If
            Next i
    End Select
    txt = Join(Arr, sep$)
    If sep$ = "" Then TB = txt: Exit Function
    While InStr(1, txt$, sep$ & sep$, vbBinaryCompare): txt$ = Replace(txt$, sep$ & sep$, sep$): Wend
    If txt$ Like "*" & sep$ Then txt = Left(txt, Len(txt) - Len(sep$))
    If txt$ Like sep$ & "*" Then txt = Mid(txt, Len(sep$) + 1)
    TB = txt
End Function

Function RegExpFindText(str As String, _
                            pattern As String, _
                            Optional Globa1 As Boolean = True, _
                            Optional IgnoreCase As Boolean = False, _
                            Optional Multiline As Boolean = False, Optional spl$ = " ") As String
Dim m() As String, i&
    Dim matches As Object 'Коллекция совпадений
    Dim match As Object 'Отдельное совпадение
    If Not pattern Like "" Then
    
        Dim REGEXP As Object 'Для регулярных выражений
        
        Set REGEXP = CreateObject("VBScript.RegExp")
        With REGEXP
            .Global = Globa1 'Находим все совпадения или только первое
            .IgnoreCase = IgnoreCase 'Учитываем ли регистр?
            .Multiline = Multiline 'Может ли паттерн попадать на разрывы строк?
            .pattern = pattern 'Выражение
        End With
        
        On Error Resume Next
        Set matches = REGEXP.Execute(str) 'Получаем коллекцию совпадений
        ReDim m(1 To matches.Count)
        Set REGEXP = Nothing 'Очистка памяти от ненужного мусора
        
        For Each match In matches
            i = i + 1
            m(i) = match.Value
'            Debug.Print match.Value
        Next
        RegExpFindText = Join(m, spl)
    End If
End Function

Function RegExpReplace_(ByVal WhichString As String, _
                        ByVal pattern As String, _
                        Optional ByVal ReplaceWith As String = " ", _
                        Optional ByVal IsGlobal As Boolean = True, _
                        Optional ByVal IsCaseSensitive As Boolean = True) As String
'Функция по регулярному выражению (маске) возвращает результат
'Declaring the object
Dim objRegExp As Object
'Initializing an Instance
Set objRegExp = CreateObject("vbscript.regexp")
'Setting the Properties
objRegExp.Global = IsGlobal
objRegExp.pattern = pattern
objRegExp.IgnoreCase = Not IsCaseSensitive
'Execute the Replace Method
RegExpReplace_ = objRegExp.Replace(WhichString, ReplaceWith)
End Function