mail mail

Обработка массивов

Выборка случайных строк из двумерного массива

Функция RandomRowsFromArray предназначена для выборки из двумерного массива случайных строк.

К примеру, исходный массив (таблица) имеет размер 1000*20 (1000 строк, и 20 столбцов)
Нам требуется выбрать из этой таблицы, случайным образом, 50 строк
(получив, таким образом, таблицу размерами 50*20)
Кроме того, необходимо, чтобы при каждом новом запуске макроса,
в выборку попадали новые строки
.

В прикреплённом к статье файле вы найдете пример такого макроса:

Sub ПримерИспользования_RandomRowsFromArray()
    ' считываем массив с листа
   arr = [a1:e20].Value
    ' считываем количество строк в выборке
   Количество = Val([NewCount])

    ' выбираем строки из массива случайным образом (получаем новый массив newarr)
   newarr = RandomRowsFromArray(arr, Количество)

    ' заносим результат на лист (справа от исходных данных)
   Range("g1").Resize(UBound(newarr, 1), UBound(newarr, 2)).Value = newarr
End Sub

Сортировка двумерного массива на 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)

Загрузка файла CSV на лист Excel

Загрузка (импорт) файла CSV на лист Excel

Надстройка предназначена для облегчения импорта данных в Excel из текстовых файлов с разделителями (например, из CSV)

Пока во вложении - обычный файл Excel с нужными макросами, надстройку выложу позже

Чтение CSV файла в двумерный массив

Функция TextFile2Array предназначена для преобразования файла CSV в двумерный массив

Очень часто при работе с текстовыми файлами (и, в частности, с файлами CSV) приходится их загружать на лист Excel, предварительно производя фильтрацию данных в этом файле.

Чтобы упростить весь процесс - от выбора файла CSV в диалоговом окне, до разбиения загруженного из файла текста в двумерный массив, и была написана эта функция.

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

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

Sub ЗагрузкаДанныхИзCSV()
    ' выбор файла по умолчанию предлагается в той же папке,
   ' где расположен текущий файл Excel
   CSVarr = TextFile2Array(, ThisWorkbook.Path, , "*.csv")

    ' проверка результата загрузки данных (выход из макроса, если данные не загружены)
   If Not IsArray(CSVarr) Then MsgBox "Файл CSV не обработан", vbCritical, "Ошибка": Exit Sub

    ' ваш код обработки двумерного массива
   Debug.Print "Загружен двумерный массив размерами " & _
                UBound(CSVarr, 1) & " строк на " & UBound(CSVarr, 2) & " столбцов"
End Sub

Быстрый поиск в двумерном массиве

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

Поскольку искомое значение может встретиться в нескольких строках обрабатываемого двумерного массива,

оба способа получают на выходе отфильтрованный двумерный массив.

Способы формирования отфильтрованных массивов - разные:

первый способ использует функцию ArrAutofilterEx

второй способ - функцию ArraySearchResults

Основные отличия и особенности этих 2 способов поиска:

  • ArrAutofilterEx позволяет задавать несколько критериев поиска (фильтрации)
  • ArrAutofilterEx ищет вхождение искомого текста в значения заданных столбцов (неточное совпадение)
  • ArrAutofilterEx при каждом вызове заново в цикле перебирает все элементы массива,
    соответственно, при поиске 10 значений время работы кода увеличивается в 10 раз
  • ArraySearchResults позволяет использовать фильтрацию массива только по одному столбцу
  • ArraySearchResults ищет совпадение искомого текста со значением столбца (точное совпадение)
  • ArraySearchResults производит поиск в заранее сформированной текстовой строке
    Таким образом, перебираются все ячейки массива в цикле только один раз, и поиск 100 значений в массиве займёт ненамного больше времени, чем поиск 1 значения.

Объединение двумерных массивов

Функция CombineArrays объединяет 2 двумерных массива ОДИНАКОВОЙ ШИРИНЫ в один массив

(второй массив "дописывается" ниже первого, путем добавления строк из второго массива в первый)

Функция возвращает массив той же ширины, что и исходные, а вертикальная размерность возвращаемого массива равна сумме количества строк исходных массивов.

 

В случае, если один из массивов не задан, функция возвращает другой заданный массив (без изменений)

ВНИМАНИЕ: все размерности массивов 1 и 2 должны совпадать (кроме первой размерности - по высоте)

Подразумевается, что индексы массивов начинаются с 1 (директива Option Base 1)

Sub ПримерОбъединенияМассивов()
    Arr1 = [a5:c10].Value    ' массив размерами 6 * 3
   Arr2 = [a24:c26].Value    ' массив размерами 3 * 3
   Arr3 = [a55:c62].Value    ' массив размерами 8 * 3

    ОбъединённыйМассив12 = CombineArrays(Arr1, Arr2)
    Debug.Print "Количество строк после объединения массивов 1 и 2:   " & _
                UBound(ОбъединённыйМассив12) ' результат: 9 (6+3)


    ОбъединённыйМассив123 = CombineArrays(Arr1, CombineArrays(Arr2, Arr3))
    Debug.Print "Количество строк после объединения массивов 1, 2 и 3:   " & _
                UBound(ОбъединённыйМассив123) ' результат: 17 (6+3+8)

End Sub

Загрузка данных из закрытой книги Excel в двумерный массив

Sub ПримерИспользования()
    ' задаём полный путь к обрабатываемому файлу
   ПутьКФайлу$ = ThisWorkbook.Path & "\" & "Contract.XLS"

    Application.ScreenUpdating = False    '  отключаем обновление экрана
   arr = LoadArrayFromWorkbook(ПутьКФайлу$, "a2", 30)    ' загружаем данные

    ' выводим результаты в окно Immediate
   Debug.Print "Загружен массив размерами " & UBound(arr, 1) & _
                " строк на " & UBound(arr, 2) & " столбцов"
End Sub

Код функции LoadArrayFromWorkbook:

Извлечение уникальных значений из диапазона ячеек или массива

Функция UniqueValuesFromArray позволяет найти в указанном столбце двумерного массива все уникальные значения, и получить новый массив, содержащий все найденные уникальные значения.
Это может пригодиться, если надо, к примеру, заполнить ComboBox на форме возможными вариантами значений из базы данных:

Private Sub UserForm_Initialize()
    On Error Resume Next: arr = PriceRange.Value
    If Err Then MsgBox "Нет строк для обработки!", vbCritical, "Ошибка": End
   
    ' заполняем комбобокс уникальными значениями из 6-го столбца таблицы
   Me.ComboBox_Source.List = UniqueValuesFromArray(arr, 6)
End Sub

Удаление "пустых строк" из массива

Удаление "пустых строк" из диапазона ячеек при помощи макроса

Function DeleteBlankRows(ByVal arr As Variant, ByVal col As Long) As Variant

Sub ПримерИспользования()
    On Error Resume Next
    arr = [a1:d15] ' считываем значения ячеек диапазона [a1:d15] в массив arr
   
    ' получаем массив arr2, в 5-м столбце которого нет пустых значений
   arr2 = DeleteBlankRows(arr, 5)
   
    [f1:z111].Clear ' очищаем диапазон ячеек [f1:z111] на листе
   
    ' вставляем массив без пустых строк обратно на лист
   [f1].Resize(UBound(arr2, 1), UBound(arr2, 2)).Value = arr2
End Sub

Преобразование массива в XML (экспорт таблицы в файл XML)

Функция Array2XML формирует из исходной таблицы объект типа DOMDocument, который можно выгрузить в XML-файл одной строкой кода (метод Save)

Sub XMLExport()
    Dim Заголовок As Range, Данные As Range
    Set Заголовок = Range("a1:f1")
    Set Данные = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, Заголовок.Columns.Count)

    arrHeaders = Application.Transpose(Application.Transpose(Заголовок.Value))
    ПутьКФайлуXML = ThisWorkbook.Path & "\result.xml"

    ' формируем DOMDocument, и сохраняем XML в файл result.xml
   Array2XML(Данные.Value, arrHeaders, "Root").Save ПутьКФайлуXML

    If Err = 0 Then MsgBox "Создан XML файл" & vbNewLine & ПутьКФайлуXML, vbInformation, "Готово"
End Sub

RSS-материал