Работа с матрицей в VBA

Внезапно появились лабораторные :)

Задачка такая:

Создать матрицу размера n x n, заполнить случайными числами от (-20 до 30). Сформировать одномерный массив от 1 до n, каждый элемент которого равен произведению положительных четных элементов данного столбца.

Решаем так (естественно все делаем в Excel):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Public Sub glav_diag()
Dim i As Integer ' Индекс строки
Dim j As Integer ' Индекс столбца
Dim q As Double ' Переменная результата для столбца
Dim cond As Integer ' Дополнительная переменная. Сколько раз выполнилось условие. Ее в принципе можно сделать булевой
 
n = InputBox("n=") ' Просим ввести n - размерность массива. У нас он всегда квадратный
 
ReDim arr(n, n) ' Объявляем его
q = 1 ' Так как у нас по условию "произведение", то мы вынуждены написать тут 1, иначе (в случае 0) произведение всегда будет равно 0
cond = 0 ' условие пока не выполнилось
' Generation of array
For i = 1 To n
For j = 1 To n
arr(i, j) = Int((-20 - 30 + 1) * Rnd + 30) ' Рандом от -20 до 30
Cells(i, j).Value = arr(i, j) ' Забить это в ячейку
Cells(i, j).Interior.ColorIndex = xlNone ' Убрать цвет если он был
Next j
Next i
 
' Обработка и вычисления
For j = 1 To n
For i = 1 To n
If ((arr(i, j) > 0) And (arr(i, j) Mod 2 = 0)) Then ' Если значение массива больше 0 и четное
q = q * arr(i, j) ' тогда домножаем его на q и записываем новый результат в q
cond = cond + 1 ' Если условие выполнилось увеличиваем переменную
Cells(i, j).Interior.Color = vbCyan ' Закрашиваем соответствующую ячейку на листе цветом
End If
Next i
If (cond > 0) Then ' Если условие выше выполнилось хотя бы раз...
Cells(n + 1, j).Value = q ' тогда записываем значение вычислений в ячейку ниже нашей матрицы
Cells(n + 1, j).Interior.Color = vbGreen ' и красим в заленый
Else
Cells(n + 1, j).Value = 0 ' Если не выполнилось пишем туда 0 (таких элементов нет) просто q записать нельзя, так как он равен 1
Cells(n + 1, j).Interior.Color = vbGreen ' и тоже в зеленый
End If
cond = 0
q = 1
Next j
End Sub
Public Sub glav_diag()
Dim i As Integer ' Индекс строки
Dim j As Integer ' Индекс столбца
Dim q As Double ' Переменная результата для столбца
Dim cond As Integer ' Дополнительная переменная. Сколько раз выполнилось условие. Ее в принципе можно сделать булевой

n = InputBox("n=") ' Просим ввести n - размерность массива. У нас он всегда квадратный

ReDim arr(n, n) ' Объявляем его
q = 1 ' Так как у нас по условию "произведение", то мы вынуждены написать тут 1, иначе (в случае 0) произведение всегда будет равно 0
cond = 0 ' условие пока не выполнилось
' Generation of array
For i = 1 To n
For j = 1 To n
arr(i, j) = Int((-20 - 30 + 1) * Rnd + 30) ' Рандом от -20 до 30
Cells(i, j).Value = arr(i, j) ' Забить это в ячейку
Cells(i, j).Interior.ColorIndex = xlNone ' Убрать цвет если он был
Next j
Next i

' Обработка и вычисления
For j = 1 To n
For i = 1 To n
If ((arr(i, j) > 0) And (arr(i, j) Mod 2 = 0)) Then ' Если значение массива больше 0 и четное
q = q * arr(i, j) ' тогда домножаем его на q и записываем новый результат в q
cond = cond + 1 ' Если условие выполнилось увеличиваем переменную
Cells(i, j).Interior.Color = vbCyan ' Закрашиваем соответствующую ячейку на листе цветом
End If
Next i
If (cond > 0) Then ' Если условие выше выполнилось хотя бы раз...
Cells(n + 1, j).Value = q ' тогда записываем значение вычислений в ячейку ниже нашей матрицы
Cells(n + 1, j).Interior.Color = vbGreen ' и красим в заленый
Else
Cells(n + 1, j).Value = 0 ' Если не выполнилось пишем туда 0 (таких элементов нет) просто q записать нельзя, так как он равен 1
Cells(n + 1, j).Interior.Color = vbGreen ' и тоже в зеленый
End If
cond = 0
q = 1
Next j
End Sub

Вот такой простой код. Все комментарии в коде.

Скачать тестовым документом

Результат работы:

 

1 Response

  1. Сергей 01.02.2015 / 16:58

    а можете написать код в ВБА для задачи : Задача B. Для матрицы размером MxN найти среднее арифметическое элементов N-го столбца
    матрица
    1,-2,3,-8
    4,5,6,7
    3,2-1,12

Добавить комментарий