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

Очистка текста от спецсимволов

Пример эксплуатации

Private Sub cmdClear_Click()
Dim i%, x%
    
    i = Len(Me!txtTestMemo)
    Debug.Print "Было: " & i & " символов."
    Me!txtTestMemo = ClearString(Me!txtTestMemo)
    
    x = Len(Me!txtTestMemo)
    Debug.Print "Стало:" & x & " символов."
    Debug.Print "Разница (удалено): " i - x & " символов."

End Sub



Функция:

Public Function ClearString(vVal As Variant) As Variant
' es 17.05.2022 - LE 19.05.2022 - v002
' Очистка текста от спецсимволов и двойных пробелов , не очень строгий вариант
' При ошибке вернёт переданное значение в неизменном виде
'---------------------------------------------------------------------------------------------------
Dim iVal As Integer
Dim iAsc As Integer        ' ANCI код символа
Dim sOne As String * 1     ' Один символ
Dim iLen As Integer        ' Длинна строки
Dim strReturn As String    ' Очищенная строка
Dim strTemp As String      ' Временная строка
'---------------------------------------------------------------------------------------------------
On Error GoTo ClearString_Err
    
    strReturn = Trim(vbNullString & vVal)  ' Перадаём значение переменной
    
'Выпрямление = Очистка от переводов строки
    strTemp = strReturn
    strReturn = Replace(strTemp, vbCr, " ") 'Перевод каретки ...
    strTemp = strReturn
    strReturn = Replace(strTemp, vbLf, " ") 'Новая срока ...
    
'Очистка от двойных пробелов - 3 раза для надёжности ...
    For iVal = 1 To 3
        strTemp = strReturn
        strReturn = Replace(strTemp, "  ", " ")
    Next iVal
    
'Очистка от прочего "хлама" - перечилено почти всё
    strTemp = strReturn
    strReturn = ""
    iLen = Len(strTemp)              ' Длинна строки
    For iVal = 1 To iLen             ' Перебераем все символы строки по циклу
        sOne = Mid(strTemp, iVal, 1) ' Получаем символ из строки
        iAsc = Asc(sOne)             ' Преобразем полученный символ в ANCII код
        'ASCII таблица: http://visualprogs.ru/all/2.html
        Select Case iAsc
            Case 0 To 31: sOne = vbNullString    ' Спецсимволы разметки
            Case 127 To 129: sOne = vbNullString ' Символы: Del + Ђ + Ѓ
            Case 140 To 144: sOne = vbNullString ' Символы: Њ + Ќ + Ћ + Џ + ђ
            Case 145 To 146: sOne = vbNullString ' Странные символы : ‘ и ’ = Долой!
            Case 147 To 148: sOne = Chr(34)      ' Кавычки"  “ и ” Меняем на обычные "
            Case 149: sOne = vbNullString        ' Символ: •
            Case 150 To 151: sOne = Chr(45)      ' Длинные тире : – и — меняем на - (45)
            Case 152 To 160: sOne = vbNullString ' Символы: ™; љ; ›; њ; ќ; ћ; џ
            Case 161 To 167: sOne = vbNullString ' Символы: Ў;ў;Ј;¤;Ґ;¦§
            Case 168:                            ' Буква: Ё
            Case 169, 170: sOne = vbNullString   ' Символы: © и Є
            Case 171: sOne = Chr(34) ' Фигурные кавычки « и » 171 и 187 - Меняем на " (34)
            Case 172: sOne = vbNullString        ' Символ: ¬
            Case 173:                ' Короткое тире: ­  Оставляем .... пока
            Case 174 To 183: sOne = vbNullString ' Символы: '®; Ї; °; ±; І; і; ґ; µ; ¶; ·
            Case 184:                            ' Буква: ё
            Case 185, 186:                       ' Символ номера: № и є
            Case 187: sOne = Chr(34) ' Фигурные кавычки « и » 171 и 187 - Меняем на " (34)
            Case 188 To 191: sOne = vbNullString ' Символы: 'ј; Ѕ; ѕ; ї
            'Дальше Кирилица пошла ...
        End Select
        strReturn = strReturn & sOne
    Next iVal

' Готово! - Возвращаем результат:
    ClearString = strReturn
    
ClearString_End:
    Exit Function
 
ClearString_Err:
    ClearString = vVal
    Err.Clear
    Resume ClearString_End
End Function

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