Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.12.2010, 01:33   #1
devchenka11
Новичок
Джуниор
 
Регистрация: 25.12.2010
Сообщений: 1
По умолчанию Сделать форму и окно вывода результатов!

Помогите пожалуйста....задали в моей программе сделать форму и окно вывода результатов....как делать вообще не знаю(
вот моя программа:

Код:
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

Последний раз редактировалось Stilet; 25.12.2010 в 12:56.
devchenka11 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сделать окно дочерним Qwe1 Win Api 12 06.12.2010 08:50
Как сделать форму Rabbiter Microsoft Office Excel 7 11.11.2009 10:19
Как сделать форму? HAMMAN Помощь студентам 1 29.01.2008 22:11
Help! Немогу написать код для посчета и вывода результатов. Руслан БД в Delphi 2 22.12.2006 13:29