Макросы VBA Excel

Макросы для сортировки одномерных и двумерных массивов, сортировки таблиц 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)

Разбиение двумерного массива на несколько массивов, группируя строки по заданному столбцу

Функция принимает в качестве параметра arr двумерный массив, и разбивает его на несколько массивов, группируя строки по значению столбца SplitColumn&

Сколько есть уникальных значений в столбце SplitColumn&, удовлетворяющих маске Mask$, - столько двумерных массивов будет возвращено функцией в виде коллекции

Например, если есть исходный массив размерами 100*5, в котором во втором столбце есть 3 разных значения,
то функция SplitArray(arr, 3) вернёт коллекцию из 3 элементов - массивов размерами 25*5, 7*5, 68*5

Чтобы откинуть строки с пустыми значениями, можно применить маску "?*"
Можно взять только строки со сзначениями, начинающимися с цифры, содержащими текст "txt", - в этом случае, в параметр Mask$ надо передать строку "#*txt*"

Пример использования функции разделения массивов на несколько:

Вывод отсортированного списка файлов

Данный код выводит список полных путей файлов, выбранных пользователем в диалоговом окне, отсортированный по дате создания файла:

Sub ВыводОтсортированногоСпискаФайлов()
    On Error Resume Next
    Dim СписокФайлов As FileDialogSelectedItems
    СтартоваяПапка = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    ' выводим окно выбора
    Set СписокФайлов = GetFilenamesCollection("Выберите файлы на рабочем столе", СтартоваяПапка)
 
    If СписокФайлов Is Nothing Then Exit Sub  ' выход, если пользователь отказался от выбора файлов
    ReDim arr(0 To СписокФайлов.Count - 1, 0 To 1)
    For Each File In СписокФайлов ' заполняем двумерный массив
        arr(i, 1) = File: arr(i, 0) = Fix(CDbl(FileDateTime(File))): i = i + 1
    Next
 
    CoolSort arr ' сортируем двумерный массив

    For i = LBound(arr) To UBound(arr)    ' выводим файлы в порядке даты создания
        Debug.Print "Дата: " & CDate(arr(i, 0)) & " - файл " & arr(i, 1)
    Next i
End Sub

Пример результата (из окна Immediate):

Дата: 27.10.2009 - файл C:\Documents and Settings\Admin\Рабочий стол\Apache LOGs parser.xls
Дата: 11.06.2010 - файл C:\Documents and Settings\Admin\Рабочий стол\123Книга1.xls
Дата: 24.09.2010 - файл C:\Documents and Settings\Admin\Рабочий стол\2010-09-24.xls
Дата: 12.11.2010 - файл C:\Documents and Settings\Admin\Рабочий стол\111.info
Дата: 28.12.2010 - файл C:\Documents and Settings\Admin\Рабочий стол\Armstrong.xls
Дата: 02.01.2011 - файл C:\Documents and Settings\Admin\Рабочий стол\buch.xls

PS: В коде использована функция сортировки двумерного массива, и функция множественного выбора файлов.