Замена разных символов строки. Функция CharSetReplace

Другим важным случаем, допускающим простую реализацию, является случай, когда замене подлежат вхождения отдельного символа, а не целой подстроки, как в общем случае. Наша функция производит замену разных символов из заданного множества на один и тот же символ. Алгоритм основан на обычном линейном просмотре и посимвольном сравнении. Сама замена производится путем выделения и конкатенации.

Эта функция понадобилась нам для реализации нового варианта функции расщепления строки, хотя она полезна и сама по себе. Приведем ее текст:

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***

Фильтрация, основанная на шаблоне. Функция WildFilter

Во многих ситуациях есть необходимость производить фильтрацию элементов массива, основываясь на шаблоне, которому должны удовлетворять фильтруемые элементы. Здесь есть полная аналогия с тем, что есть потребность производить замену на основе шаблона, а не точного образца. Поэтому естественно наше желание расширить стандартные возможности функции Filter, тем более, что реализуется эта возможность достаточно просто. Рассмотрим реализацию нашей функции:

Public Function WildFilter(sourcearray() As String, ByVal match As String, _

Optional ByVal include As Boolean = True) As Variant

'Эта функция фильтрует элементы исходного массива, проверяя их на соответствие шаблону 'match. В отличие от стандартной функции Filter элементы проверяются на точное 'соответствие но шаблон match может включать специальные символы шаблона.

'Возвращается массив отобранных элементов. Если булев параметр include равен True

'то отбираются элементы, совпадающие с шаблоном, в противном случае - не совпадающие.

Dim Sel() As String

Dim i As Long, j As Long

j = 1

If include Then

For i = LBound(sourcearray) To UBound(sourcearray)

If sourcearray(i) Like match Then

ReDim Preserve Sel(1 To j)

Sel(j) = sourcearray(i): j = j + 1

End If

Next i

Else

For i = LBound(sourcearray) To UBound(sourcearray)

If Not (sourcearray(i) Like match) Then

Sel(j) = sourcearray(i): j = j + 1

End If

Next i

End If

WildFilter = Sel

End Function

Параметры этой функции сохраняют смысл стандартной функции Filter. Единственное отличие состоит в том, что теперь аргумент match задает настоящий шаблон, допускающий специальные символы. Чтобы быть справедливым, заметим, что теперь речь идет о точном соответствии шаблону, в то время, как в стандартной функции речь идет о вхождении шаблона в элемент. Так что обе функции имеют свои сферы применения. Реализация достаточно очевидна и основана на прямом использовании операции Like. Приведем тестовый пример, в котором вызывается наша функция:

Public Sub testWildFilter()

Dim Txt As String, resTxt As String

Dim Artxt() As String, ResAr() As String

Txt = "123, 5, 117, 7, 189"

Artxt = Split(Txt, ", ")

ResAr = WildFilter(Artxt, "1##")

resTxt = Join(ResAr, ", ")

Debug.Print resTxt

ResAr = WildFilter(Artxt, "[3-57-9]")

resTxt = Join(ResAr, ", ")

Debug.Print resTxt

End Sub

Приведем результаты ее работы:

123, 117, 189

5, 7