TopPicLogo TopPicText

Чистка строки от "мусора" по списку, переданному через массив

Пример использования функции:

Dim i%, s$
Dim ch() As Variant 'массив

    i = CInt(TB_SelLength)
    If i > 30 Then i = 30
    s = Mid(Me!txtTextField, 1, i) 'взяли строку из поля 
    'Создаём массив из подлежащего удалению из строки перечислением через запатую: 
    '(Поясню: тут, в начале символ перевода строки, а в конце ТРИ пробела подряд)
    ch = Array(vbCrLf, ".", ",", ":", ";", "?", "!", "(", ")", "   ")

    'Очищаем от перечисленного выше с заменой на пробел 
    Me!txtSearch = CleanStrByArray(s, ch, " ") 

Функция:

Public Function CleanStrByArray(sString$, vArr() As Variant, Optional sReplace$ = "") As String
'es 29.07.2016
'Чистка строки от "мусора" по списку, переданному через массив (vArr)
'Возвращает очищенную строку
'Удобно когда необходимо почистить строчку от нескольких вариантов вхождений
'--------------------------------------------------------------------------
'Аргументы:
'   sString    - Очищаемая строка
'   vArr       - массив заменяемого
'   sReplace   - Опциональный - На что это всё меняем (по умолчанию "")
'--------------------------------------------------------------------------
Dim i%, sSearch$, sReturn$

On Error GoTo CleanStrByArray_Err
    sReturn = sString
    For i = LBound(vArr) To UBound(vArr)
        sSearch = vArr(i)
        sReturn = Replace(sReturn, sSearch, sReplace, 1) 'убираем
    Next i
    CleanStrByArray = Trim(sReturn)

CleanStrByArray_Bye:
    Exit Function

CleanStrByArray_Err:
    CleanStrByArray = ""
    MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & "в процедуре: CleanStrByArray", vbCritical, "Error in module modSearchInTextBox"
    Resume CleanStrByArray_Bye
End Function

Назад ToTop
L.E. 30.07.2016
Рейтинг@Mail.ru