mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Сортировка двумерного массива на VB (VBA)

Сортировка двумерного массива по нулевому столбцу

Public Function CoolSort(SourceArr As Variant) As Variant
    ' сортировка двумерного массива по нулевому столбцу
    Dim Check As Boolean, iCount As Integer, jCount As Integer, nCount As Integer
    ReDim tmpArr(UBound(SourceArr, 2)) As Variant
    Do Until Check
        Check = True
        For iCount = LBound(SourceArr, 1) To UBound(SourceArr, 1) - 1
            If Val(SourceArr(iCount, 0)) > Val(SourceArr(iCount + 1, 0)) Then
                For jCount = LBound(SourceArr, 2) To UBound(SourceArr, 2)
                    tmpArr(jCount) = SourceArr(iCount, jCount)
                    SourceArr(iCount, jCount) = SourceArr(iCount + 1, jCount)
                    SourceArr(iCount + 1, jCount) = tmpArr(jCount)
                    Check = False
                Next
            End If
        Next
    Loop
    CoolSort = SourceArr
End Function

Та же функция, только с возможностью выбора столбца для сортировки двумерного массива:

Function CoolSort(SourceArr As Variant, ByVal N As Integer) As Variant
    ' сортировка двумерного массива по столбцу N
    If N > UBound(SourceArr, 2) Or N < LBound(SourceArr, 2) Then _
       MsgBox "Нет такого столбца в массиве!", vbCritical: Exit Function
    Dim Check As Boolean, iCount As Integer, jCount As Integer, nCount As Integer
    ReDim tmpArr(UBound(SourceArr, 2)) As Variant
    Do Until Check
        Check = True
        For iCount = LBound(SourceArr, 1) To UBound(SourceArr, 1) - 1
            If Val(SourceArr(iCount, N)) > Val(SourceArr(iCount + 1, N)) Then
                For jCount = LBound(SourceArr, 2) To UBound(SourceArr, 2)
                    tmpArr(jCount) = SourceArr(iCount, jCount)
                    SourceArr(iCount, jCount) = SourceArr(iCount + 1, jCount)
                    SourceArr(iCount + 1, jCount) = tmpArr(jCount)
                    Check = False
                Next
            End If
        Next
    Loop
    CoolSort = SourceArr
End Function


Сортировка двумерного массива на листе Excel, по первым 3 столбцам по возрастанию
(создаётся временная книга из 1 листа для сортировки массива, после сортировки книга закрывается)

Function SortArrayOnExcelWorksheet(ByRef arr) As Boolean
    On Error Resume Next: Err.Clear
    ' возвращает FALSE, если массив не поддается сортировке (не влазит на лист Excel)
    Application.ScreenUpdating = False
    Dim WB As Workbook, sh As Worksheet, ra As Range
    Set WB = Workbooks.Add(xlWBATWorksheet)
    If WB Is Nothing Then Exit Function
    Set sh = WB.Worksheets(1)
    Set ra = sh.Range("a1").Resize(UBound(arr, 1), UBound(arr, 2))
    ra.FormulaR1C1Local = arr
    If Err Then Debug.Print "Ошибка вставки массива для сортировки на лист": WB.Close False: Exit Function
 
    ra.Sort ra.Cells(1), 1, ra.Cells(2), , 1, ra.Cells(3), 1, xlNo ' сортировка массива

    If Err Then Debug.Print "Ошибка сортировки массива": WB.Close False: Exit Function
 
    arr = ra.FormulaR1C1Local
    SortArrayOnExcelWorksheet = True
    WB.Close False
End Function

Пример использования:

SortArrayOnExcelWorksheet arr


Ну и обычная пузырьковая сортировка одномерного массива

Public Sub BubbleSort(ByRef arr)
    N = UBound(arr)
    For i = 0# To N - 1# Step 1
        For J = 0# To N - 2# - i Step 1
            If arr(J) > arr(J + 1#) Then
                Tmp = arr(J)
                arr(J) = arr(J + 1#)
                arr(J + 1#) = Tmp
            End If
        Next J
    Next i
End Sub

то же самое, но внутри макроса (arr - одномерный массив)

    For i& = LBound(arr) To UBound(arr) - 1
        For j& = LBound(arr) To UBound(arr) - 2 - i
            If arr(j) > arr(j + 1) Then Tmp = arr(j): arr(j) = arr(j + 1): arr(j + 1) = Tmp
        Next j
    Next i

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

А только мне кажется, что в пузырьке строка
For j& = LBound(arr) To UBound(arr) - 2 - i
должна быть
For j& = LBound(arr) To UBound(arr) - 1 - i
?? Пять лет прошло так-то...

Алексей, очень помогли, спасибо!

Спасибо!

Просто, большое человеческое спасибо! Двумерка заработала!

Здравствуйте,а как применить данную программу,только если в ячейках сортированной матрицы были квадраты чисел?

Искал алгоритм, набрел на этот, но написал свой.
Первый алгоритм неэффективный. Очень много перестановок, а это самая долгая операция.
Предлагаю более простой и сортировка по любому количеству столбцов в любом порядке. Кому надо направление сортировки и произвольные границы, можете доработать сами. Последняя строка массива передается, потому что массив может быть заполнен не весь

Private Sub SortArray(myArray, countRows, ParamArray sortC())
Dim cRA%, cR%, minR%, cS%, cE%, countC%, tempV
..For cRA = 0 To countRows - 1
....minR = cRA
....For cR = cRA + 1 To countRows - 1
......For cS = 0 To UBound(sortC)
........If myArray(cR, sortC(cS)) <> myArray(minR, sortC(cS)) Then
..........If myArray(cR, sortC(cS)) < myArray(minR, sortC(cS)) Then minR = cR
..........Exit For
........End If
......Next
....Next
....If minR > cRA Then
......'меняем местами строки
......For cC = 0 To UBound(myArray, 2)
........tempV = myArray(cRA, cC)
........myArray(cRA, cC) = myArray(minR, cC)
........myArray(minR, cC) = tempV
......Next
....End If
..Next
End Sub

Вызов: SortArray Ar, 5, 2, 0, 1
Ar - массив, 5 - последняя строка, 2, 0, 1 - столбцы для сортировки

Как записать массив на лист я указал в комментариях http://excelvba.ru/code/Array2worksheet#comment-2866
Для сортировки двумерного массива по нужному столбцу нужна другая функция (если нужно, напишу).

Огромное спасибо за помощь!

Алина, если бы вы пролистали статью немного вниз,
то в комментах нашли бы ответ на вопрос, как отсортировать текст:
http://excelvba.ru/code/SortArray#comment-729

Пример использования

sub макрос()
  arr = range("a1:d10").value ' считываем матрицу (массив) с листа Excel 
  CoolSort arr, 3 ' сортируем по 3 столбцу
  range("a1:d10").value = arr ' записываем результат обратно на лист
end sub

Можно ли использовать второй макрос (где можно выбрать столбец) для сортировки двумерного массива по 3-му столбцу, если в столбце не числа, а текст, т.е. упорядочить по алфавиту?
И еще, подскажите, (конечно, глупый вопрос, но если не спрашивать, то как тогда научиться?!) как эту функцию вызвать и как полученную отсортированную матрицу записать на лист Excel?
Заранее спасибо!

Очередная, применённая мною, функция из раздела "Обработка массивов".
Уже и не помню пятая или шестая, в течение достаточно короткого времени.
Все работает отлично.
Спасибо Вам за Ваш труд!

На самом деле не самая быстрая сортировка получается, особенна разница видна при >1000 строк и больше 3х столбцов. Я бы предложил Quick sort использовать. Примерно так:
где a() это массив, который нужно отсортировать (двумерный), n - это номер стобца по которому сортирует, а low и high это начальная и конечная строка диапазона, который нужно отсортировать, если нужно отсортировать весь массив, то естественно - это начало и конец массива

Public Sub aQSort2(ByRef a() As Variant, ByVal n As Integer, ByRef low As Long, ByRef high As Long)
Dim i As Long, j As Long, k As Long
Dim m As Variant, wsp As Variant
i = low
j = high
m = a(Round((i + j) \ 2), n)
Do Until i > j
Do While a(i, n) < m
i = i + 1
Loop
Do While a(j, n) > m
j = j - 1
Loop
If (i <= j) Then
For k = LBound(a, 2) To UBound(a, 2)
wsp = a(i, k)
a(i, k) = a(j, k)
a(j, k) = wsp
Next k
i = i + 1
j = j - 1
End If
Loop
If (low < j) Then aQSort2 a(), n, low, j
If (i < high) Then aQSort2 a(), n, i, high
End Sub

Справлюсь, конечно, но дёлать не буду -не люблю студентов-халявщиков, которые пытаются взять меня "на слабо"

В матрице С(8,6) в каждом столбце расставить элементы по возрастанию и найти значение минимального элемента матрицы.
А сможете для этого программу написать на языке VBA.

спасибо! заодно новый метод вывода освоила)) написала вам в ICQ

Вот так будет правильно:

Sub v7zad16()
    Dim a() As Integer, N As Integer, i As Integer, j As Integer
    N = Val(InputBox("vved n"))
 
    ReDim a(1 To N, 1 To N + 1)
    Randomize Timer
 
    For i = 1 To N
        For j = 1 To N
            a(i, j) = Rnd * 10
            a(i, N + 1) = a(i, N + 1) + a(i, j)
        Next j
    Next i
 
    Cells.Clear    ' очистка ячеек

    Cells(1, 1) = "исходная матрица"
    Cells(2, 1).Resize(N, N).Value = a    ' вывод на лист

    CoolSort a, N + 1    ' сортируем
    Cells(N + 3, 1) = "сортированнная матрица"
    Cells(N + 4, 1).Resize(N, N + 1).Value = a    ' вывод на лист
End Sub

Результат:

результат сортировки двумерного массива

При помощи датчика случайных чисел заполнить действительную квадратную матрицу A порядка N (N ввести с клавиатуры). Переставить строки матрицы так, чтобы сумма элементов строк была возрастающая. Вывести сумму элементов строк, а также матрицу A до и после преобразования.

Sub v7zad16()
 
Dim a() As Integer, N As Integer, b() As Integer, t As Double, jmax As Long
Dim i As Integer, j As Integer, k As Integer, kk As Integer
Sheets("Лист16").Select: Cells.Clear 
N = Val(InputBox("vved n"))
ReDim a(N, N + 1) 
ReDim b(N, N + 1)
Randomize Timer 
For i = 1 To N 
For j = 1 To N  
  a(i, j) = Rnd * 10
  Cells(i, j) = a(i, j)
  a(i, N + 1) = a(i, N + 1) + a(i, j) 
Next j
 Cells(i, N + 1) = a(i, N + 1) 
Next i
 
 
b(N, N + 1)=CoolSort (a(n,n+1),n+1)
 
End Sub

если так, то ругается

как его хоть вызвать то

да эт понятно. у меня это всё равно потом пересекается. а метод Sort мне не понравился. мягко говоря.
за сайт спасибо.

Степан, этот макрос предназначен для сортировки МАССИВА, а не ДИАПАЗОНА ЯЧЕЕК.
Чтобы отсортировать диапазон ячеек - достаточно макроса из одной строки
(метод Sort объекта Range)

Полезный макрос. Спасибо. Жаль только, что формулы все херит.

Можно сортировать и как текст.
Для этого замените строку

If Val(SourceArr(iCount, N)) > Val(SourceArr(iCount + 1, N)) Then

на
If cstr(SourceArr(iCount, N)) > cstr(SourceArr(iCount + 1, N)) Then

Жаль, что сортирует только числовые данные, а работает быстро :)

Спасибо Вам огромнейшее! :)

Добавил в текст статьи вариант функции с изменяемым номером столбца для сортировки

Здравствуйте. А возможно применить сортировку массива по 2-му, третьему столбцу? Какой параметр следует изменить? Спасибо.

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  ____               _____            ____   ____  
|___ \ __ __ |___ | _ _ / ___| | _ \
__) | \ \ /\ / / / / | | | | | | | | | |
/ __/ \ V V / / / | |_| | | |___ | |_| |
|_____| \_/\_/ /_/ \__, | \____| |____/
|___/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.