Опубликован: 13.09.2006 | Уровень: для всех | Доступ: свободно | ВУЗ: Тверской государственный университет
Лекция 9:
Операции и встроенные функции
Замена разных символов строки. Функция 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 Function8.5.
Параметры этой функции сохраняют смысл стандартной функции 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
