‘ Пример 1 увеличение значений в выделенных ячейках на константу
Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 06.11.2008
Dim a, i, j, it, jt As Integer
'Зададим окно ввода (диалог с пользователем)
a = InputBox("const", "Vvedite const")
' вызываем InputBox для получения константы и присваиваем его переменной а.
'Jt И it –размер выделенной области
jt = Selection.Columns.Count
it = Selection.Rows.Count
'Изменение значений в ячейках
For i = 1 To it
For j = 1 To jt
'к выделенным ячейкам прибавляется значение равное а
Selection.Cells(i, j).Value = Selection.Cells(i, j).Value + a
Next j
Next i
End Sub
‘ Пример 2 В ячейку вводятся числа 1,2 или 3. Отобразить их значения прописью
Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 06.11.2008
'
If (ActiveCell.FormulaR1C1 = "1") Then ActiveCell.FormulaR1C1 = "один"
If (ActiveCell.FormulaR1C1 = "2") Then ActiveCell.FormulaR1C1 = "два"
If (ActiveCell.FormulaR1C1 = "3") Then ActiveCell.FormulaR1C1 = "три"
End Sub
‘ Пример 3 Заполнение интервала ячеек случайными числами
Sub StickRandom()
Dim numRows As Integer, numCols As Integer
Dim theRow As Integer, theCol As Integer
'Определение размера текущего выбора.
numRows = Selection.Rows.Count
numCols = Selection.Columns.Count
Randomize
'Инициализация генератора случайных чисел
For theRow = 1 To numRows
For theCol = 1 To numCols
Selection.Cells(theRow, theCol).Value = Int(Rnd * 100)
Next theCol
Next theRow
End Sub
‘Пример 4 Вычисление среднего значения элементов массива
Sub BlockAverage()
Dim numRows As Integer, numCols As Integer
Dim theRow As Integer, theCol As Integer
Dim I As Integer, J As Integer
Dim theAverage As Single, theSum As Single
Dim myArray() As Single
'Определение размера текущего выбора.
numRows = Selection.Rows.Count
numCols = Selection.Columns.Count
ReDim myArray(numRows, numCols)
'Копирование содержимого ячеек в массив.
For theRow = 1 To numRows
For theCol = 1 To numCols
myArray(theRow, theCol) = Selection.Cells(theRow, theCol).Value
Next theCol
Next theRow
' Определение среднего арифметического элементов массива.
theSum = 0
For I = 1 To numRows
For J = 1 To numCols
theSum = theSum + myArray(I, J)
Next J
Next I
theAverage = theSum / (numRows * numCols)
MsgBox "Среднее арифметическое = " & Str(theAverage)
End Sub
‘ Пример 5 Расчет возраста в днях
Sub AgeCalculator()
Dim theReply As String, thePrompt As String
Dim theTitle As String, theDefault As String
Dim theAge As Single, OKFlag As Boolean
Dim theName As String
thePrompt = "Введите Ваше имя, пожалуйста."
theTitle = "Персональный информационный диалог"
theDefault = "Имя"
'Цикл ожидания ввода имени пользователя.
Do
theReply = InputBox(thePrompt, theTitle, theDefault)
If theReply = "" Then Exit Sub
'Нажата командная кнопка Cancel.
theReply = Trim(theReply)
'Удаление пробелов с двух сторон строки.
'Проверка на строку пробелов или пробел в строке.
If (theReply = "") Or (InStr(theReply, " ") <> 0) Then
MsgBox "Непонятно, попробуйте еще раз, пожалуйста.", , theTitle
OKFlag = False
ElseIf theReply = theDefault Then 'Пользователь просто нажал Enter
MsgBox "Напечатайте что-нибудь и попробуйте еще раз, пожалуйста."
OKFlag = False
Else
'Ввод завершен нормально.
theName = theReply
OKFlag = True
End If
Loop Until OKFlag
'Теперь получим имя пользователя.
thePrompt = "Здравствуйте, " & theReply & ". Введите Ваш возраст, пожалуйста."
'Цикл ожидания ввода корректного числа.
Do
theReply = InputBox(thePrompt, theTitle)
If theReply = "" Then Exit Sub
'Нажата командная кнопка Cancel.
theAge = Val(theReply)
'Преобразование строки в число.
If Not IsNumeric(theReply) Then
'Введено не число.
MsgBox "Введите число и попробуйте еще раз, пожалуйста.", , theTitle
OKFlag = False
'Проверка корректности введенного числа.
ElseIf (theAge < 1) Or (theAge > 120) Then
MsgBox "Не верится, чтобы Вам было " & Str(theAge) & _
"лет. Попробуйте еще раз, пожалуйста.", , theTitle
OKFlag = False
Else
'Похоже на возраст.
OKFlag = True
End If
Loop Until OKFlag
'Расчет приблизительного возраста в днях.
MsgBox "Вам приблизительно " & Format(theAge * 365, "#,###") & " дней.", , theTitle
End Sub
‘Пример 6 Сложение 2-х вводимых чисел
Sub prim4()
a = InputBox("введите а", "ввод данных", 1)
b = InputBox("введите в", "ввод данных", 2)
c = Val(a) + Val(b)
MsgBox c
End Sub
‘Пример 7 Вычисление квадрата чисел от 1 до 10
Sub prim5()
For I = 1 To 10 Step 1
n = I * I
MsgBox "I = " & Str(I) & " n = " & Str(n)
Next I
End Sub
