Dim res As Byte Dim

Public Sub LikeOperation() Const pat1 = "[A-Z]" Const pat2 = "[a-z]" Const pat3 = "[!a-z]" Const pat4 = "[3-5]" Dim res As Byte Dim Sym As String
res = "Кук" Like "К[аоу]к" Debug.Print res
res = "f" Like pat1 Debug.Print res res = "f" Like pat2 Debug.Print res res = "f" Like pat3 Debug.Print res
res = "5" Like pat4 Debug.Print res Sym = "3" res = Sym Like pat1 & pat4 Debug.Print res res = Sym Like pat1 Or Sym Like pat4 Debug.Print res
End Sub

Пример 8.1.

Закрыть окно

Public Function AppPath( Disk As String, Dir As String, FileName As String) As String 'Эта Функция возвращает в качестве результата полный путь активного документа 'Ее параметры содержат компоненты этого пути - имя диска, каталог на диске и имя файла Dim MyDoc As Document Dim Path As String Dim Start As Byte, Finish As Byte
'Определяем полный путь к файлу, задающему активный документ Word Set MyDoc = ActiveDocument Path = MyDoc.FullName
'Выделяем имя диска - первый символ полного пути Disk = VBA.Left(Path, 1)
'Выделяем каталог, в котором хранится документ Start = VBA.InStr(1, Path, "\") Finish = VBA.InStrRev(Path, "\") Dir = VBA.Mid(Path, Start + 1, Finish - Start)
'Выделяем имя файла FileName = VBA.Mid(Path, Finish + 1)
'Возвращается результат - полный путь к каталогу AppPath = VBA.Left(Path, Finish) End Function
Public Sub MyPath() Dim Path As String Dim Dir As String Dim Disk As String Dim FileName As String Path = AppPath(Disk, Dir, FileName) Debug.Print Disk, Dir, FileName, Path
End Sub

Пример 8.2.

Закрыть окно

Public Sub SplitAndJoin() ' В этой процедуре сложное предложение разделяется на простые 'А затем после обработки строка восстанавливается 'Здесь же демонстрируется фильтрация элементов массива 'Объявляем динамический массив Dim Simple() As String, i As Byte Dim Simple1() As String, Res As String Dim Simple2() As String 'Размерность массива Simple устанавливается автоматически 'в соответствии с размерностью массива, возвращаемого функцией Split Simple = Split("А это пшеница, которая в темном чулане хранится в доме, " _ & "который построил Джек", ", ") 'Создаем новый массив ReDim Simple1(1 To UBound(Simple) + 2) Simple1(1) = "А это веселая птица - синица" Simple1(2) = "которая часто ворует пшеницу" For i = 3 To UBound(Simple1) Simple1(i) = Simple(i - 2) Next i 'Создаем строку из массива Simple1
Res = Join(Simple1, ", ") Debug.Print Res 'Фильтрация элементов массива Simple2 = Filter(Simple1, "котор") Res = Join(Simple2, ", ") Debug.Print Res
Simple2 = Filter(Simple1, "котор", False) Res = Join(Simple2, ", ") Debug.Print Res End Sub

Пример 8.3.

Закрыть окно

Public Function WildReplace( ByVal expr As String, ByVal find As String, _ ByVal Rep As String, Optional ByVal delimiter As String = " ") As String
'Эта функция применима в том частном случае, когда строка - источник, заданная аргументом Expr 'представляет совокупность элементов, отделяемых разделителями. 'Типичный пример - строка представляет совокупность слов, разделенных пробелами. 'Как и обычная функция Replace эта функция производит замену вхождений элемента (подстроки) новым значением 'Отличие от стандартной функции состоит в том, что заменяемый элемент (подстрока) find 'задается шаблоном. В результате разные элементы могут быть заменены на новое значение. 'Для этого частного случая WildReplace существенно расширяет стандартные возможности Replace
'Алгоритм основан на том факте, что строка допускает разбор ее на элементы, 'а к элементам применима операция Like - сравнения с шаблоном.
Dim Words() As String, i As Long, Res As String
'Разбор строки на элементы Words = Split(expr, delimiter)
'Сравнение элементов с шаблоном и замена в случае совпадения For i = LBound(Words) To UBound(Words) If Words(i) Like find Then Words(i) = Rep Next i
'Сборка строки Res = Join(Words, delimiter) WildReplace = Res End Function

Пример 8.4.

Закрыть окно

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

Пример 8.5.

Закрыть окно

Public Function WildSplit( expr As String, Optional ByVal delimiter As String = " ", _ Optional ByVal limit As Long = -1, Optional ByVal compare As VbCompareMethod = vbBinaryCompare) As Variant
'Также, как и стандартная функция Split, эта функция расщепляет строку - источник expr 'на элементы, используя разделители, заданные аргументом delimiter 'Отличие состоит в том, что при выделении элементов предполагается, что разделителем 'может быть любой из символов множества delimeter, возможно, окруженный пробелами
Dim Source As String, ResAr() As String Dim find As String, Rep As String Dim i As Long
Source = expr find = VBA.Mid$(delimiter, 2) Rep = VBA.Left$(delimiter, 1) 'Заменяем в строке все разделители на один из них Source = CharSetReplace(Source, find, Rep)
'Теперь используем стандартную функцию Split ResAr = Split(Source, Rep, limit, compare)
'Удаляем пробелы For i = LBound(ResAr) To UBound(ResAr) ResAr(i) = VBA.Trim$(ResAr(i)) Next i WildSplit = ResAr End Function

Пример 8.6.

Закрыть окно

Public Sub Speed() ' Эта программа выполняет замеры времени вычислений над данными разного типа
Dim Start As Single, Finish As Single Dim i As Long, j As Long Dim bx As Byte, by As Byte, bz As Byte Dim ix As Integer, iy As Integer, iz As Integer Dim lx As Long, ly As Long, lz As Long Dim sx As Single, sy As Single, sz As Single Dim dx As Double, dy As Double, dz As Double
For i = 1 To 5 'Внешний цикл для повторения замеров времени Start = Timer For j = 1 To 100000 bx = 99: by = 101 bz = by * (by - bx) \ by Next j Finish = Timer Debug.Print "Тип Byte: Время ", i, " = ", Finish - Start Debug.Print "bz = ", bz
Start = Timer For j = 1 To 100000 ix = 99: iy = 101 iz = iy * (iy - ix) \ iy Next j Finish = Timer Debug.Print "Тип Integer: Время ", i, " = ", Finish - Start Debug.Print "iz = ", iz
Start = Timer For j = 1 To 100000 lx = 99: ly = 101 lz = ly * (ly - lx) \ ly Next j Finish = Timer Debug.Print "Тип Long: Время ", i, " = ", Finish - Start Debug.Print "lz = ", lz
Start = Timer For j = 1 To 100000 sx = 99: sy = 101 sz = sy * (sy - sx) / sy Next j Finish = Timer Debug.Print "Тип Single: Время ", i, " = ", Finish - Start Debug.Print "sz = ", sz
Start = Timer For j = 1 To 100000 dx = 99: dy = 101 dz = dy * (dy - dx) / dy Next j Finish = Timer Debug.Print "Тип Double: Время ", i, " = ", Finish - Start Debug.Print "dz = ", dz
Next i
End Sub

Пример 8.7.

Закрыть окно

Содержание раздела