Сортировка многомерного массива в VBA

Question

Я определил следующий массив Dim myArray(10,5) as Long и хотел бы его отсортировать.Каков наилучший способ сделать это?

Мне нужно будет обрабатывать много данных, таких как матрица 1000 x 5.Он содержит в основном цифры и даты и должен сортировать его по определенному столбцу

Answer 1

Вот QuickSort с несколькими столбцами и одним столбцом для VBA, модифицированный из примера кода, опубликованного Джимом Речем в Usenet.

Примечания:

Вы заметите, что я делаю много больше защитного кодирования, чем вы можете увидеть в большинстве примеров кода в Интернете: это форум Excel, и вы должны предвидеть нулевые и пустые значения ... Или вложенныемассивы и объекты в массивах, если ваш исходный массив поступает, скажем, из стороннего источника рыночных данных реального времени.

Пустые значения и недопустимые элементы отправляются в конец списка.

ВашВызов будет:

QuickSort MyArray,,,2

... Передача '2' в качестве столбца для сортировки и исключение необязательных параметров, которые проходят верхнюю и нижнюю границы области поиска.

[EDITED] - исправлен нечетный сбой форматирования в тегах , который, по-видимому, имел проблему с гиперссылками в комментариях к коду.

Гиперссылка, которую я удалил, была ОбнаружениеВариант массива в VBA .

Public Sub QuickSortArray(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1, Optional lngColumn As Long = 0)
    On Error Resume Next

    'Sort a 2-Dimensional array

    ' SampleUsage: sort arrData by the contents of column 3
    '
    '   QuickSortArray arrData, , , 3

    '
    'Posted by Jim Rech 10/20/98 Excel.Programming

    'Modifications, Nigel Heffernan:

    '       ' Escape failed comparison with empty variant
    '       ' Defensive coding: check inputs

    Dim i As Long
    Dim j As Long
    Dim varMid As Variant
    Dim arrRowTemp As Variant
    Dim lngColTemp As Long

    If IsEmpty(SortArray) Then
        Exit Sub
    End If
    If InStr(TypeName(SortArray), "()") < 1 Then  'IsArray() is somewhat broken: Look for brackets in the type name
        Exit Sub
    End If
    If lngMin = -1 Then
        lngMin = LBound(SortArray, 1)
    End If
    If lngMax = -1 Then
        lngMax = UBound(SortArray, 1)
    End If
    If lngMin >= lngMax Then    ' no sorting required
        Exit Sub
    End If

    i = lngMin
    j = lngMax

    varMid = Empty
    varMid = SortArray((lngMin + lngMax) \ 2, lngColumn)

    ' We  send 'Empty' and invalid data items to the end of the list:
    If IsObject(varMid) Then  ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a valid default member or property
        i = lngMax
        j = lngMin
    ElseIf IsEmpty(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf IsNull(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf varMid = "" Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) = vbError Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) > 17 Then
        i = lngMax
        j = lngMin
    End If

    While i <= j
        While SortArray(i, lngColumn) < varMid And i < lngMax
            i = i + 1
        Wend
        While varMid < SortArray(j, lngColumn) And j > lngMin
            j = j - 1
        Wend

        If i <= j Then
            ' Swap the rows
            ReDim arrRowTemp(LBound(SortArray, 2) To UBound(SortArray, 2))
            For lngColTemp = LBound(SortArray, 2) To UBound(SortArray, 2)
                arrRowTemp(lngColTemp) = SortArray(i, lngColTemp)
                SortArray(i, lngColTemp) = SortArray(j, lngColTemp)
                SortArray(j, lngColTemp) = arrRowTemp(lngColTemp)
            Next lngColTemp
            Erase arrRowTemp

            i = i + 1
            j = j - 1
        End If
    Wend

    If (lngMin < j) Then Call QuickSortArray(SortArray, lngMin, j, lngColumn)
    If (i < lngMax) Then Call QuickSortArray(SortArray, i, lngMax, lngColumn)

End Sub

... И версия массива с одним столбцом:

Public Sub QuickSortVector(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1)
    On Error Resume Next

    'Sort a 1-Dimensional array

    ' SampleUsage: sort arrData
    '
    '   QuickSortVector arrData

    '
    ' Originally posted by Jim Rech 10/20/98 Excel.Programming


    ' Modifications, Nigel Heffernan:
    '       ' Escape failed comparison with an empty variant in the array
    '       ' Defensive coding: check inputs

    Dim i As Long
    Dim j As Long
    Dim varMid As Variant
    Dim varX As Variant

    If IsEmpty(SortArray) Then
        Exit Sub
    End If
    If InStr(TypeName(SortArray), "()") < 1 Then  'IsArray() is somewhat broken: Look for brackets in the type name
        Exit Sub
    End If
    If lngMin = -1 Then
        lngMin = LBound(SortArray)
    End If
    If lngMax = -1 Then
        lngMax = UBound(SortArray)
    End If
    If lngMin >= lngMax Then    ' no sorting required
        Exit Sub
    End If

    i = lngMin
    j = lngMax

    varMid = Empty
    varMid = SortArray((lngMin + lngMax) \ 2)

    ' We  send 'Empty' and invalid data items to the end of the list:
    If IsObject(varMid) Then  ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a default member or property
        i = lngMax
        j = lngMin
    ElseIf IsEmpty(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf IsNull(varMid) Then
        i = lngMax
        j = lngMin
    ElseIf varMid = "" Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) = vbError Then
        i = lngMax
        j = lngMin
    ElseIf VarType(varMid) > 17 Then
        i = lngMax
        j = lngMin
    End If

    While i <= j

        While SortArray(i) < varMid And i < lngMax
            i = i + 1
        Wend
        While varMid < SortArray(j) And j > lngMin
            j = j - 1
        Wend

        If i <= j Then
            ' Swap the item
            varX = SortArray(i)
            SortArray(i) = SortArray(j)
            SortArray(j) = varX

            i = i + 1
            j = j - 1
        End If

    Wend

    If (lngMin < j) Then Call QuickSortVector(SortArray, lngMin, j)
    If (i < lngMax) Then Call QuickSortVector(SortArray, i, lngMax)

End Sub

Я использовал BubbleSort для такого рода вещей, но этосильно замедляется после того, как массив превысит 1024 строки.Я включил приведенный ниже код для справки: обратите внимание, что я не предоставил исходный код для ArrayDimensions, поэтому он не будет скомпилирован для вас, если вы не реорганизуете его - или не разделите его на версии «Array» и «vector».

Public Sub BubbleSort(ByRef InputArray, Optional SortColumn As Integer = 0, Optional Descending As Boolean = False)
' Sort a 1- or 2-Dimensional array.


Dim iFirstRow   As Integer
Dim iLastRow    As Integer
Dim iFirstCol   As Integer
Dim iLastCol    As Integer
Dim i           As Integer
Dim j           As Integer
Dim k           As Integer
Dim varTemp     As Variant
Dim OutputArray As Variant

Dim iDimensions As Integer



iDimensions = ArrayDimensions(InputArray)

    Select Case iDimensions
    Case 1

        iFirstRow = LBound(InputArray)
        iLastRow = UBound(InputArray)

        For i = iFirstRow To iLastRow - 1
            For j = i + 1 To iLastRow
                If InputArray(i) > InputArray(j) Then
                    varTemp = InputArray(j)
                    InputArray(j) = InputArray(i)
                    InputArray(i) = varTemp
                End If
            Next j
        Next i

    Case 2

        iFirstRow = LBound(InputArray, 1)
        iLastRow = UBound(InputArray, 1)

        iFirstCol = LBound(InputArray, 2)
        iLastCol = UBound(InputArray, 2)

        If SortColumn  InputArray(j, SortColumn) Then
                    For k = iFirstCol To iLastCol
                        varTemp = InputArray(j, k)
                        InputArray(j, k) = InputArray(i, k)
                        InputArray(i, k) = varTemp
                    Next k
                End If
            Next j
        Next i

    End Select


    If Descending Then

        OutputArray = InputArray

        For i = LBound(InputArray, 1) To UBound(InputArray, 1)

            k = 1 + UBound(InputArray, 1) - i
            For j = LBound(InputArray, 2) To UBound(InputArray, 2)
                InputArray(i, j) = OutputArray(k, j)
            Next j
        Next i

        Erase OutputArray

    End If


End Sub

Этот ответ, возможно, пришел с некоторым опозданием, чтобы решить вашу проблему, когда вам нужно, но другие люди ответят на него, когда отправят в Google ответы на аналогичные проблемы.

Answer 2

Сложность в том, что VBA не предоставляет простого способа поменять строки в двумерном массиве.Для каждого свопинга вам нужно будет перебрать 5 элементов и свопить каждый из них, что будет очень неэффективно.

Я предполагаю, что 2D-массив действительно не тот, который вы должны использовать в любом случае, хотя,У каждого столбца есть определенное значение?Если да, то не следует ли вам использовать массив определенного пользователем типа или массив объектов, которые являются экземплярами модуля класса?Даже если 5 столбцов не имеют определенного значения, вы все равно можете сделать это, но определите UDT или модуль класса, чтобы иметь только один член, который является 5-элементным массивом.

Для самого алгоритма сортировкиЯ бы использовал обычную сортировку вставок.1000 наименований на самом деле не так уж велики, и вы, вероятно, не заметите разницы между сортировкой вставкой и быстрой сортировкой, если мы убедились, что каждый обмен не будет слишком медленным.Если вы do используете быструю сортировку, вам необходимо тщательно ее кодировать, чтобы убедиться, что вам не хватит места в стеке, что можно сделать, но это сложно, а быстрая сортировка достаточно сложнауже.

Итак, если вы используете массив UDT и что UDT содержит варианты с именами от Field1 до Field5, и если мы хотим отсортировать по Field2 (например), тогда код может выглядеть примерно так...

Type MyType
    Field1 As Variant
    Field2 As Variant
    Field3 As Variant
    Field4 As Variant
    Field5 As Variant
End Type

Sub SortMyDataByField2(ByRef Data() As MyType)
    Dim FirstIdx as Long, LastIdx as Long
    FirstIdx = LBound(Data)
    LastIdx = UBound(Data)

    Dim I as Long, J as Long, Temp As MyType
    For I=FirstIdx to LastIdx-1
        For J=I+1 to LastIdx
            If Data(I).Field2 > Data(J).Field2 Then
                Temp = Data(I)
                Data(I) = Data(J)
                Data(J) = Temp
            End If
        Next J
    Next I
End Sub

Answer 3

Я собираюсь предложить немного другого кода для подхода Стива.

Все действительные замечания по эффективности, но, честно говоря ... когда я искал решение, я мог меньше заботиться об эффективности. Его VBA ... Я отношусь к этому, как он заслуживает.

Вы хотите отсортировать 2-й массив. Обычная простая грязная простая сортировка вставки, которая будет принимать массив переменного размера и сортировать по выбранному столбцу.

Sub sort_2d_array(ByRef arrayin As Variant, colid As Integer)
'theWidth = LBound(arrayin, 2) - UBound(arrayin, 2)
For i = LBound(arrayin, 1) To UBound(arrayin, 1)
    searchVar = arrayin(i, colid)
    For ii = LBound(arrayin, 1) To UBound(arrayin, 1)
        compareVar = arrayin(ii, colid)
        If (CInt(searchVar) > CInt(compareVar)) Then
            For jj = LBound(arrayin, 2) To UBound(arrayin, 2)
                larger1 = arrayin(i, jj)
                smaller1 = arrayin(ii, jj)
                arrayin(i, jj) = smaller1
                arrayin(ii, jj) = larger1
            Next jj
            i = LBound(arrayin, 1)
            searchVar = arrayin(i, colid)
        End If
        Next ii
    Next i
End Sub

Answer 4

иногда самый безмозглый ответ - лучший ответ.

1. добавить чистый лист
2. скачать ваш массив на этот лист
3. добавить поля сортировки
4. применить сортировку
5. перезагрузите данные листа обратно в ваш массив, это будет то же измерение
6. удалить лист

tadaa. Я не получу никаких призов за программирование, но он быстро справится с работой.

Answer 5

Вы можете сделать отдельный массив с 2 столбцами.Столбец 1 будет тем, что вы сортируете, а 2 - тем, что находится в другом массиве.Сортируйте этот массив по столбцу 1 (при переключении поменяйте только два столбца).Затем вы можете использовать 2 массива для обработки данных по мере необходимости.Хотя огромные массивы могут вызвать проблемы с памятью

Answer 6

Для чего бы это ни стоило (я не могу показать код на данный момент ... позвольте мне посмотреть, смогу ли я отредактировать его для публикации), я создал массив пользовательских объектов (поэтому каждое из свойств поставляется с любым элементом, его отсортировано по), заполнил набор ячеек интересующими объектами свойствами каждого элемента, затем использовал функцию сортировки Excel через vba для сортировки столбца. Я уверен, что, вероятно, есть более эффективный способ сортировки, чем экспорт в ячейки, я просто еще не понял. Это на самом деле мне очень помогло, потому что когда мне нужно было добавить измерение, я просто добавил свойство let и get для следующего измерения массива.

Answer 7

Мне кажется, что код QuickSort выше не может обрабатывать пробелы. У меня есть массив с числами и пробелами. Когда я сортирую этот массив, записи с пробелами смешиваются между записями с номерами. Мне потребовалось много времени, чтобы выяснить это, поэтому, вероятно, полезно помнить об этом при использовании этого кода.

лучший, Marcel