Помогите пожалуйста....задали в моей программе сделать форму и окно вывода результатов....как делать вообще не знаю(
вот моя программа:
Код:
Const n = 30 'Количество случайных чисел
Dim X(n) As Integer 'массив из случайных чисел
Dim sX(n) As Integer 'массив из случайных чисел
Dim fCount As Integer 'счетчик
Dim k As Integer '
Sub Ivanova()
'
' Ivanova Макрос
' Макрос записан 14.12.2010 (julie)
'
' Сочетание клавиш: Ctrl+z
'
Cells.Clear 'Очистка
Range("A1:I1").Select 'Выбираем верхнюю строку, где надписи
Selection.Font.Bold = 1 'Устанавливаем жирный шрифт
Cells(1, 1) = "X[30]"
Random 'Пункт 1 - генерируем случайные числа
Cells(1, 3) = "Фильтрация"
Filter 'Пункт 2 - фильтруем
Cells(1, 5) = "Матрица"
k = InputBox("Введите размерность матрицы: ")
Matrix (k) 'Пункт 3 - матрица
Range("A1").Select
End Sub
Sub Random()
Randomize 'Инициализируем генератор случайных чисел
For i = 1 To n
X(i) = Int(IIf(Rnd < 0.5, Rnd * 5 + 1, Rnd * 4 + 7))
Cells(i + 1, 1).Value = X(i)
Next i
End Sub
Sub Filter()
Dim q As Byte, min As Integer, max As Integer
q = 1
min = X(1)
max = X(1)
'Поиск минимального и максимального значений
For i = 1 To n
If X(i) < min Then
min = X(i)
End If
If X(i) > max Then
max = X(i)
End If
Next i
Cells(1, 2).Font.Bold = 1
Cells(1, 2) = "Максимум"
Cells(2, 2) = max
j = 1
For k = 1 To n 'выводим максимумы
If X(k) >= max / 4 And X(k) <= max Then
sX(k) = X(k)
Cells(j + 1, 3) = sX(k)
j = j + 1
End If
Next k
End Sub
Sub Matrix(k As Integer) 'процедура создания матрицы
Dim q As Integer, min As Integer, cur As Integer, S(n * n) As Integer
u = k + 3 'смещение упорядоченной матрицы
For i = 1 To k 'Заполняем матрицу
For j = 1 To k
Cells(i + 1, j + 4) = Cells(j - 1 + k * (i - 1) + 2, 3)
If Not IsEmpty(Cells(i + 1, j + 4)) Then
S(j - 1 + k * (i - 1)) = Cells(i + 1, j + 4)
Else
S(j - 1 + k * (i - 1)) = 0
Cells(i + 1, j + 4) = 0
End If
Next j
Next i
For i = 0 To k * k - 1 'Сортируем значения в матрице
min = i
For j = i To k * k - 1
If S(j) < S(min) Then
min = j
End If
Next j
tmp = S(i)
S(i) = S(min)
S(min) = tmp
Next i
'--------------------------------------------------------------------------
Cells(u, 5).Font.Bold = 1
Cells(u, 5) = "Упорядоченная матрица"
a = 0
For q = -k To k
For tX = 1 To k 'Заполняем упорядоченную матрицу
For tY = 1 To k
If tX = tY - q Then 'если матрица не переполнена
Cells(tX + u, tY + 4) = S(a) 'заполняем клетку
a = a + 1
End If
Next tY
Next tX
Next q
End Sub