VBA, MS Access MS Access в примерах

Очистка текста от спецсимволов и прочего для использования при поиске

Public Function ClearSearchString(vVal As Variant) As String
' es 20.03.2019 v03
' Очистка текста от спецсимволов и прочего для использования при поиске
'--------------------------------------------------------------------------
' Оператор Like (Visual Basic) - Описание и Параметры шаблона поиска:
' https://docs.microsoft.com/ru-ru/dotnet/visual-basic/language-reference/operators/like-operator
'--------------------------------------------------------------------------
' Like - оператор VBA для сравнения строки с шаблоном. Нечеткий поиск
' http://macros-vba.ru/knigi/133-operator-vba-like-sravnenie-stroki-s-shablonom-nechetkij-poisk
'--------------------------------------------------------------------------
' Коды символов например тут:
' http://autoit-script.ru/autoit3_docs/appendix/ascii.htm
'--------------------------------------------------------------------------

Dim i As Integer
Dim iAsc As Integer        ' ANCI код символа
Dim sMid As String * 1     ' выделенный символ
Dim siLen As Integer       ' длинна очищаемой строки
Dim strNew As String       ' Очищенная строка
'--------------------------------------------------------------------------
' Пример эксплуатации:
' ?ClearSearchString("Папа у' Васи ""силён""*  в матиматике №[4556]#- %;Иногда#")
' Вернёт:
' Папа у? Васи ?силён?* в матиматике №[4556]#? %?Иногда#
'--------------------------------------------------------------------------

On Error GoTo ClearSearchString_Err
    strNew = CStr(vVal)    ' Передаём строку локальной переменной
    strNew = Trim(strNew)  ' Убираем пробелы по краям текста
    
'Очистка от двойных пробелов (не обязательно, но точно не помешает)
    strNew = Replace(strNew, "  ", " ") ' первый проход
    strNew = Replace(strNew, "  ", " ") ' и второй проход (на случай ...)  :)
    
    siLen = Len(strNew)    ' считаем длинну строки
    For i = 1 To siLen     ' перебераем все символы строки по циклу
        sMid = Mid(strNew, i, 1)    ' получаем символ из строки
        iAsc = Asc(sMid)            ' преобразовываем полученный символ в ANCII код
        Select Case iAsc
            Case 0 To 31:    sMid = ""   ' Спецсимволы разметки
            Case 32, 33:     sMid = sMid ' Пробел и Восклицательный знак - Нужны!
            Case 34:         sMid = ""   ' Двойная кавычка
            Case 35:         sMid = sMid ' "#" - Решётка (знак числа) - Нужна!
            Case 38, 39:     sMid = "?"  ' Амперсанд "&" и Апостров "'"
            Case 42:         sMid = sMid ' Звёздочка "*" - Нужна!
            Case 43 To 45:   sMid = ""   ' "+", "-" и дальше до точки (под вопросом)
            Case 58 To 62:   sMid = ""   ' Не нужно (под вопросом)
            Case 123 To 126: sMid = ""   ' Фигурные скобки и пр.
            Case 127:        sMid = ""   ' del
            Case 171, 187:   sMid = ""   ' "«" и "»"
        End Select
        ClearSearchString = ClearSearchString & sMid
    Next i

    
    ClearSearchString = Replace(ClearSearchString, "  ", " ") 'Очистка от двойных пробелов
    ClearSearchString = Replace(ClearSearchString, " *", "*") 'Пробелы слева от Звёздочки "*"
    ClearSearchString = Replace(ClearSearchString, "* ", "*") 'Пробелы справа от Звёздочки "*"

ClearSearchString_End:
    On Error Resume Next
    Err.Clear
    Exit Function

ClearSearchString_Err:
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
        "in Function: ClearSearchString in module: 00_Tests", vbCritical, "Error in Application"
    Err.Clear
    Resume ClearSearchString_End
End Function

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