MS VBA | Cycles (Циклы)

Работу цикла удобно "просматривать" по шагам. Перед вызовом поставьте BreakPoint, например, на начало функции/процедуры, затем вызовите код с помощью F5 или в окне Immediate.

В этом разделе:

➢Переходы Goto

➢Обычный цикл с применением If

➢Обычный цикл, сокращаем If применяем Do While - "пока"

➢Сокращенный цикл While

➢Обычный цикл, сокращаем If применением Until - "до тех пор"

➢Цикл с фиксированным числом повторений выполнения команды - For, Next

➢Цикл с указанием шага, например, обратный отсчет

➢Создание паузы на заданное количество секунд

➢Поиск пробелов в строке, счетчик слов в строке на основании данных пробелов

➢Каждую первую букву каждого слова преобразуем в заглавную

➢Переворачиваем слова в строке

➢Все цифры заменяем на пробел

➢Функция, разделяющая буквы исходной строки дефисами

➢Первые три символа взять в скобки, остальные символы разбить на кусочки из двух (между кусочками пробел)

➢Отделить слова по пробелу, положить каждое слово в отдельные поля таблицы. Пример функции (работаем с Recordset).

Переходы Goto

Sub Password()

Dim pass As String 'сюда кладем строку, которую введет польз-ль через InputBox

lbl:

pass = InputBox("Введите пароль")

If pass = "123" Then

MsgBox "Пароль верен"

Else

GoTo lbl 'если польз. ввел неверный пароль, повторить InputBox и проверку...

End If

End Sub

Обычный цикл с применением If

Sub Hello5()

Dim i As Integer

i = i + 1

MsgBox "Привет " & i & "-й раз"

If i = 5 Then

Exit Do 'выйти из цикла

End If

Loop 'продолжить цикл (i еще <> 5)

End Sub

Обычный цикл, сокращаем If применяем Do While - "пока"

Sub Hello5()

Dim i As Integer

Do While i <> 5

i = i + 1

MsgBox "Привет " & i & "-й раз"

Loop

End Sub

Сокращенный цикл While

Sub Hello5()

Dim i As Integer

While i <> 5

i = i + 1

MsgBox "Привет " & i & "-й раз"

Wend

End Sub

Обычный цикл, сокращаем If применением Until - "до тех пор"

Sub Hello5()

Dim i As Integer

Do Until i = 5

i = i + 1

MsgBox "Привет " & i & "-й раз"

Loop

End Sub

Цикл с фиксированным числом повторений выполнения команды - For, Next

Sub Hello5() ' - без указания шага

Dim i As Integer

For i = 1 To 5

MsgBox "Привет " & i & "-й раз"

End Sub

Цикл с указанием шага, например, обратный отсчет

Sub Hello5()

Dim i As Integer

For i = 5 To 1 Step -1

MsgBox "Привет " & i & "-й раз"

End Sub

Создание паузы на заданное количество секунд

Sub delay(del) ' - del - задаем количество секунд

Dim r As Date

r = Now

Do Until DateDiff("s", r, Now) >= del

Loop

End Sub

Поиск пробелов в строке, счетчик слов в строке на основании данных пробелов

'на входе строка, на выходе количество слов в данной строке

Function WordCount(MyStr As String) As Integer

Dim wc As Integer, space As Integer

'wc - переменная в которую кладем количество слов

'space - определитель позиции очередного пробела

space = InStr(MyStr, " ")

'InStr - функция находит заданные символы в строке

Do While space <> 0

wc = wc + 1

MyStr = Trim(Mid(MyStr, space + 1))

space = InStr(MyStr, " ")

Loop

WordCount = wc + 1

End Function

Каждую первую букву каждого слова преобразуем в заглавную

Function WordTitleCase(MyStr As String) As String

Dim space As Integer, resStr As String ' строка в которую кладем результат

space = InStr(MyStr, " ")

'space - определитель позиции очередного пробела

'InStr - функция находит заданные символы в строке

Do While space <> 0

resStr = resStr & UCase(Left(MyStr, 1)) & LCase(Mid(MyStr, 2, space - 1))

'формируется результирующая строка

MyStr = Trim(Mid(MyStr, space + 1))

' отрезаем

space = InStr(MyStr, " ")

Loop

WordTitleCase = resStr & UCase(Left(MyStr, 1)) & LCase(Mid(MyStr, 2))

End Function

Переворачиваем слова в строке

Function Reverse(MyStr As String) As String

Dim i As Integer ' счетчик символов

Dim resStr As String ' результат

For i = 1 To Len(MyStr)

resStr = Mid(MyStr, i, 1) & resStr

Reverse = resStr

End Function

Все цифры заменяем на пробел

Function DigitToSpace(MyStr As String) As String

Dim i As Integer, resStr As String, ch As String 'переменная для очередного символа строки

'i - счетчик цикла

For i = 1 To Len(MyStr)

ch = Mid(MyStr, i, 1)

If ch >= "0" And ch <= "9" Then

ch = " "

End If

resStr = resStr & ch

DigitToSpace = resStr

End Function

Функция, разделяющая буквы исходной строки дефисами

Function DivideWithDefis(MyStr As String) As String

Dim lett As String ' очередной символ строки

Dim resStr As String ' результат

Dim i As Integer ' счетчик цикла

For i = 1 To Len(MyStr)

lett = Mid(MyStr, i, 1)

resStr = resStr & lett & "-"

DivideWithDefis = Left(resStr, Len(resStr) - 1)

' взять всю строку слева по последний символ без одного (т.е. без '-')

End Function

Первые три символа взять в скобки, остальные символы разбить на кусочки из двух (между кусочками пробел)

Function BracketedString(MyStr As String) As String

Dim resStr As String 'результат_1

Dim lett As String ' первый кусочек (три символа в скобках)

Dim i As Integer ' счетчик цикла

Dim lett2 As String 'второй кусочек

Dim ResStr2 As String 'результат_2 - окончательный

lett = "(" & Left((MyStr), 3) & ")"

lett2 = Mid(MyStr, 3)

For i = 5 To Len(MyStr)

resStr = resStr & Mid(lett2, i, 2) & " "

ResStr2 = lett & resStr

BracketedString = ResStr2

End Function

Повернуть слова (с последнего к первому)

Function WordReverse(MyStr As String) As String

Dim space As Integer, resStr As String ' строка в которую кладем результат

space = InStr(MyStr, " ")

Do While space <> 0

resStr = (Mid(MyStr, 1, space)) & resStr

' обработка первого слова (взять первое слово с первой буквы по первый пробел)

MyStr = Trim(Mid(MyStr, space + 1))

' обработка последующих (взять след. букву от первого пробела)

space = InStr(MyStr, " ")

Loop

WordReverse = MyStr & " " & resStr

End Function

Отделить слова по пробелу, положить каждое слово в отдельные поля таблицы

Пример функции:

'есть таблица TableName

'есть поле в таблице - Name, в котором хранятся данные типа: Anna Petrosyan

'есть поле в таблице FirstName и поле LastName, в которые нужно положить в первое Anna, во второе Petrosyan

Function WordSeparator()

Dim mydb As Database

Dim rst As Recordset

Dim MyStr As String

Dim space As Integer

'space - определитель позиции очередного пробела

Dim resStrPreliminary As String 'предварительный результат 1-й

Dim resStr As String ' результат 1-й

Dim resStr2 As String 'результат 2-й

Set mydb = CurrentDb()

Set rst = mydb.OpenRecordset("TableName")

rst.MoveFirst

MyStr = rst!Name

Do Until rst.EOF

space = InStr(MyStr, " ")

'InStr - функция находит заданные символы в строке

resStrPreliminary = resStr & UCase(Left(MyStr, 1)) & LCase(Mid(MyStr, 2, space - 1))

'UCase - функция преобразования верхнего регистра

'LCase - функция преобразования нижнего регистра

resStr = Trim(resStrPreliminary)

resStr2 = Trim(Mid(MyStr, space + 1))

rst.Edit

rst!FirstName = resStr2

rst!LastName = resStr

rst.Update

rst.MoveNext

On Error GoTo err

MyStr = rst!Name

resStr = " "

resStr2 = " "

Loop

Exit Function

err:

MsgBox Error$

Exit Function

End Function