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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 11.12.2011, 23:37   #1
x3 aka a-droo
Новичок
Джуниор
 
Регистрация: 11.12.2011
Сообщений: 2
По умолчанию Упорядочить матрицу по убыванию модулей элементов

Столкнулся с проблемой

вобщем нужно отсортировать двумерный массив по убыванию модулей элементов

пока смог сделать только такую сортировку при которой элементы массива заменяются их модулями, а как я понимаю из условия задачи "Упорядочить матрицу по убыванию модулей элементов" нужно оставить все значения как и были , но при этом упорядочить по значениям их модулей.

делал по аналогии с вот этим

Код:
Dim indM, k, i, arr() As Single
n = 5
ReDim arr(1 To n)
arr(1) = 4
arr(2) = -3
arr(3) = 0
arr(4) = 3
arr(5) = -10
Dim Min As Single
For i = 1 To n - 1
 Min = arr(i)
 k_min = i
  For j = i + 1 To n
  If arr(j) < Min Then
   Min = arr(j)
   k_min = j
  End If
  Next
  arr(k_min) = arr(i)
  arr(i) = Min
Next

ну и пример на матрицах , как я понял условие

ВВОДИМ
3 -4 5
2 6 -9
7 -8 -1

ПОЛУЧАЕМ
-9 -8 7
6 5 -4
3 2 -1


а вот ,что получается в моей проге

9 8 7
6 5 4
3 2 1

у элементов с отрицательным значением теряются минусы,а их нужно оставить.

Код:
Sub Sort()       
 
ReDim B(1 To m * n)
 
For i = 1 To m                          'преобразуем в одномерный
   For j = 1 To n
     B(j + (i - 1) * n) = A(i, j)
   Next j
Next i
 
For i = 1 To m * n - 1                     'сортирую
 Min = Abs(B(i))
 k_min = i
  For j = i + 1 To m * n
   If Abs(B(j)) > Min Then
    Min = Abs(B(j))
    k_min = j
   End If
  Next
 B(k_min) = Abs(B(i))
 B(i) = Min
Next
 
For i = 1 To m                            'преобразуем в двумерный
   For j = 1 To n
      A(i, j) = B(j + (i - 1) * n)
   Next j
Next i
         
 
 
ListBox3.ColumnCount = n                               'вывод
ListBox3.List = A                               
End Sub
Вложения
Тип файла: zip 1cyberforum.zip (18.0 Кб, 8 просмотров)
x3 aka a-droo вне форума Ответить с цитированием
Старый 12.12.2011, 00:42   #2
Казанский
Старожил
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 2,133
По умолчанию

Можно завести еще один массив со знаками (например, 1 и -1) и выполнять в нем перестановки синхронно с массивом абсолютных значений. Потом перемножить.

Но почему бы не использовать средства Excel для сортировки диапазона?
Код:
Sub Sort()

ReDim B(1 To m * n, 1 To 1) 'двумерный!

For i = 1 To m                          'преобразуем в одномерный
   For j = 1 To n
     B(j + (i - 1) * n, 1) = A(i, j)
   Next j
Next i
                                        'сортировка
With Worksheets.Add
    .Range("A1:A" & UBound(B)).Value = B
    .Range("B1:B" & UBound(B)).Formula = "=ABS(A1)"
    .Range("B1").Sort .Range("B1"), xlDescending, header:=xlNo
    B = .Range("A1:A" & UBound(B)).Value
    Application.DisplayAlerts = False
    .Delete
    Application.DisplayAlerts = True
End With

For i = 1 To m                            'преобразуем в двумерный
   For j = 1 To n
      A(i, j) = B(j + (i - 1) * n, 1)
   Next j
Next i

End Sub
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
Казанский вне форума Ответить с цитированием
Старый 12.12.2011, 01:21   #3
x3 aka a-droo
Новичок
Джуниор
 
Регистрация: 11.12.2011
Сообщений: 2
По умолчанию

Казанский,
спасибо за подсказку
но всё же желательно на циклах сделать)

на другом форуме помогли, я ещё доделал и получился рабочий код.

Код:
For i = 1 To m * n - 1                   
 Min = B(i)
 k_min = i
  For j = i + 1 To m * n
   If Abs(B(j)) > Abs(Min) Then
    Min = B(j)
    k_min = j
   End If
  Next
 B(k_min) = B(i)
 B(i) = Min
Next
проверил несколько раз, вроде всё работчает как часы)
x3 aka a-droo вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Упорядочить по убыванию побочную диагональ матрицы. vadiprog Помощь студентам 2 04.12.2011 22:55
Двухмерный массив - Упорядочить элементы матрицы А, расположив их по убыванию в строках. U4-nik Помощь студентам 3 13.05.2011 22:59
упорядочить строки по убыванию характеристик STUDENTKA-DKE Паскаль, Turbo Pascal, PascalABC.NET 2 20.01.2011 11:35
Помогите упорядочить строки матрицы по убыванию kitty Помощь студентам 1 06.12.2007 23:23
Упорядочить символьный список по убыванию элементов - язык Пролог yulia Помощь студентам 4 07.10.2007 18:53