VBA, Раскрасить матрицу

Сделать элементы главной диагонали матрицы одним цветом, выше — другим, ниже третьим.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Public Sub glav_diag()
Dim i As Integer
Dim j As Integer
 
n = InputBox("n=")
 
For i = 1 To n
  For j = 1 To n
    If i = j Then
      Cells(i, j).Interior.Color = vbGreen
    End If
    If i < j Then
      Cells(i, j).Interior.Color = vbRed
    End If
    If i > j Then
      Cells(i, j).Interior.Color = vbBlack
    End If
  Next j
Next i
End Sub
Public Sub glav_diag()
Dim i As Integer
Dim j As Integer

n = InputBox("n=")

For i = 1 To n
  For j = 1 To n
    If i = j Then
      Cells(i, j).Interior.Color = vbGreen
    End If
    If i < j Then
      Cells(i, j).Interior.Color = vbRed
    End If
    If i > j Then
      Cells(i, j).Interior.Color = vbBlack
    End If
  Next j
Next i
End Sub

Проход по всему массиву и если i=j (главная диагональ) то зеленым, если i<j (выше) то красный, в ином случае черным. Пример:

Continue reading

Работа с матрицей в 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

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

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

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

Continue reading

Форум «Облачные технологии в Сибири. Новые возможности для бизнеса»

Привет!

Сегодня компания РТКОММ совместно с Сибконгрес’ом провели форум, обозначенный в заголовке. Программу можно посмотреть тут

Пробегусь по лекторам (даже мелким) и постараюсь рассказать о каждом докладе чуть-чуть + мнение. Да, и будет чуть-чуть фоток :)

Continue reading