MyTetra Share
Делитесь знаниями!
Сортировка двумерного массива на VB (VBA)
30.12.2017
22:46
Текстовые метки: Сортировка,vba,sort,SortArray
Раздел: VBA - Сортировка

Сортировка двумерного массива на 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
  • 40647 просмотров
 
MyTetra Share v.0.52
Яндекс индекс цитирования