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

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

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 12.12.2011, 01:49   #11
doober
Старожил
 
Аватар для doober
 
Регистрация: 02.05.2009
Сообщений: 3,907
По умолчанию

Цитата:
Сообщение от mad_moon Посмотреть сообщение
а как написать такую программу используя только For Next?
Вот так.
На выбор и по возростанию,и по убыванию
Код:

Option Base 1
Option Explicit

 Sub Rgr()
 Dim A() As Double, i As Integer, j As Integer, n As Integer, m As Integer, Min As Integer
 Dim k As Integer, l As Integer, R As Integer, ingex1 As Integer, index2 As Integer
 n = Val(InputBox("Aaaa?ou ?enei ?yae?a:", "Aaaaaiiy ?ici??iino? iao?eo?", "5"))
 m = Val(InputBox("Aaaa?ou ?enei noiai?ee?a:", "Aaaaaiiy ?ici??iino? iao?eo?", "6"))
 ReDim A(n, m)
 Randomize Time
 For i = 1 To n
 For j = 1 To m
 A(i, j) = Int(Rnd * 100) - Int(Rnd * 100)
 Cells(i, j) = A(i, j)
 Next j
 Next i
 SortMin A
  For i = 1 To n
 For j = 1 To m
 Cells(i + n + 1, j + n + 1) = A(i, j)
 Next j
 Next i
 SortMax A
 For i = 1 To n
 For j = 1 To m
 Cells(i + n + 10, j + n + 1) = A(i, j)
 Next j
 Next i
 End Sub

Sub SortMin(ByRef arr)
Dim i As Integer, j As Integer, n As Integer, m As Integer, c As Integer
Dim Min As Integer, Pos As Integer, Temp As Integer
m = UBound(arr, 1)
n = UBound(arr, 2)
 For c = 1 To m
      For i = 1 To n - 1
           Min = arr(c, i)
           Pos = i
             For j = i + 1 To n
                 If arr(c, j) < Min Then
                       Min = arr(c, j)
                       Pos = j
                       Temp = arr(c, i)
                       arr(c, i) = arr(c, Pos)
                       arr(c, Pos) = Temp
                       Pos = j
                 End If
 Next: Next: Next
End Sub

Sub SortMax(ByRef arr)
Dim i As Integer, j As Integer, n As Integer, m As Integer, c As Integer
 Dim Max As Integer, Pos As Integer, Temp As Integer
m = UBound(arr, 1)
n = UBound(arr, 2)
 For c = 1 To m
      For i = 1 To n - 1
           Max = arr(c, i)
           Pos = i
             For j = i + 1 To n
                 If arr(c, j) > Max Then
                      Max = arr(c, j)
                       Pos = j
                       Temp = arr(c, i)
                       arr(c, i) = arr(c, Pos)
                       arr(c, Pos) = Temp
                       Pos = j
                 End If
 Next: Next: Next
End Sub
Анализ,обработка данных Недорого
doober вне форума Ответить с цитированием
Старый 12.12.2011, 23:37   #12
mad_moon
 
Регистрация: 08.05.2011
Сообщений: 9
Радость

спасибо))

у меня еще вопросик есть
а как поставить минимальное на последнее место (чтобы отсортировать по убыванию но с использованием минимального значения)?
mad_moon вне форума Ответить с цитированием
Ответ


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

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Ошибка run-time Error 1004 общая ошибка ODBC kaval88 Microsoft Office Excel 0 27.02.2011 20:20
Периодическая ошибка Run-time error -2147417848 (80010108) Automation error в файле с макросом faraviper Microsoft Office Excel 0 24.02.2011 16:23
Ошибка run-time error 13 Type mismatch в VBA Kracozebr Microsoft Office Word 9 19.07.2010 16:10
ReDim и Subscript out of range (Error 9) oldfatham Microsoft Office Excel 5 24.08.2009 18:32
Ошибка Run-Time error 13 DEZuv Microsoft Office Access 0 03.04.2009 12:25