Другим важным случаем, допускающим простую реализацию, является случай, когда замене подлежат вхождения отдельного символа, а не целой подстроки, как в общем случае. Наша функция производит замену разных символов из заданного множества на один и тот же символ. Алгоритм основан на обычном линейном просмотре и посимвольном сравнении. Сама замена производится путем выделения и конкатенации.
Эта функция понадобилась нам для реализации нового варианта функции расщепления строки, хотя она полезна и сама по себе. Приведем ее текст:
Public Function CharSetReplace(ByVal expr As String, ByVal find As String, _ ByVal Rep As String)
'Эта функция применима в том частном случае, когда в строке - источнике Expr 'требуется произвести замену символов, входящих в множество, заданное аргументом find 'на символ (последовательность символов), заданных аргументом rep
Dim Source As String Dim i As Long, Sym As String Dim N As Long
N = Len(expr) Source = expr For i = 1 To N Sym = VBA.Mid$(Source, i, 1) If InStr(1, find, Sym) Then Source = VBA.Left$(Source, i - 1) & Rep & VBA.Mid$(Source, i + 1) End If Next i CharSetReplace = Source End Function
Приведем теперь тестовую процедуру, организующую вызов функции CharSetReplace:
Public Sub testCharSetReplace() Dim Text As String Text = "test123" Text = CharSetReplace(Text, "1234567890", "*") Debug.Print Text Text = "Шла кошка по крыше" Text = CharSetReplace(Text, "аоеиуыяюэ", "*") Debug.Print Text End Sub
В результате ее работы в окне отладки появляются следующие данные:
Шл* к*шк* п* кр*ш* Agent***, Agent***, Агент Майор Пронин, Agent***