Разное

Vba excel двумерный массив: VBA Excel. Массивы (одномерные, многомерные, динамические)

Использование двумерных массивов в VBA на уроках информатики



VBA — универсальный язык программирования. С помощью его можно создавать полноценные приложения на Visual Basic, поскольку эти языки — близкие родственники. Создавать программы на нем можно очень быстро и легко, не нужно заботиться об установке и настройке среды программирования и наличии нужных библиотек на компьютере пользователя — MS Office есть практически на любом компьютере. Рассмотрим пример создания программы с использованием двумерных массивов.

Удобство среды VBA заключается в том, что она внедрена в пакет прикладных программ Microsoft Office и, соответственно, является доступной практически на любом ПК, не требует установки дополнительного программного обеспечения.

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

Массив — набор однотипных переменных, объединенных одним именем и доступных через это имя и порядковый номер переменной в наборе. Организуем в электронных таблицах Excel двумерный массив А, состоящий из 20 х 10 = 200 элементов. Для этого в Excel создадим поле, в котором определим элементы массива целыми случайными числами от 1 до 100.

Рис. 1. Поле двумерного массива в Excel

Перейдём во вкладку Разработчик → Visual Basic. Затем вкладка Insert → Module. Откроется окно для создания программного кода.

Рис. 2. Окно для создания программного кода

Sub Двумерный_Массив()

Dim A(20, 10) As Integer

For i = 1 To 20 ‘Число строк в массиве

For j = 1 To 10 ‘Число столбцов в массиве

A(i, j) = Int(Rnd * 100 + 1) ‘Задание массива целыми числами от 1 до 100

Cells(i, j) = A(i, j)

Next j

Next i

При выполнении программы на активном листе Excel образуется следующее поле:

Рис. 3. Заполнение двумерного массива в Excel

Определим переменные для нахождения максимального, минимального, среднего значения в таблице, кроме того, вычислим сумму и размах таблицы. Все перечисленные переменные целые, кроме действительного среднего значения. Присвоим им соответствующие типы данных: Dim Max, Min, Сумма, Размах As Integer, Среднее As Single.

Используя принцип математической индукции, найдём наибольшее и наименьшее значения таблицы: If A(i, j) >Max Then Max = A(i, j)

If A(i, j)

Для вычисления суммы: Сумма = Сумма + A(i, j), среднего значения: Среднее = Сумма / 200, размаха таблицы: Размах = Max — Min. Результат программы будет следующий:

Sub Двумерный_Массив()

Dim A(20, 10) As Integer

Dim Max, Min, Сумма, Размах As Integer, Среднее As Single

Max = 0 ‘Начальное значение Максимального элемента в массиве

Min = 100 ‘Начальное значение Минимального элемента в массиве

Сумма = 0

For i = 1 To 20 ‘Число строк в массиве

For j = 1 To 10 ‘Число столбцов в массиве

A(i, j) = Int(Rnd * 100 + 1) ‘Задание массива целыми числами от 1 до 100

Cells(i, j) = A(i, j)

If A(i, j) >= Max Then Max = A(i, j) ‘Вычисление Максимального элемента в массиве

If A(i, j)

Сумма = Сумма + A(i, j) ‘Вычисление Суммы

Next j

Next i

Среднее = Сумма / 200 ‘Вычисление Среднего значения

Размах = Max — Min

Range(«A22″).Value = «Max =»

Range(«A23″).Value = «Min =»

Range(«A24″).Value = «Сумма =»

Range(«A25″).Value = «Среднее =»

Range(«A26″).Value = «Размах =»

Range(«B22″).Value = Max

Range(«B23″).Value = Min

Range(«B24″).Value = Сумма

Range(«B25″).Value = Среднее

Range(«B26″).Value = Размах

End Sub

Для создания копии таблицы, сдвинем её на 11 позиций вправо.

‘Создание копии таблицы

For i = 1 To 20

For j = 1 To 10

Cells(i, j + 11) = A(i, j)

Next j

Next i

Наглядно видно, что перед нами копия таблицы.

Рис. 4. Копия таблицы

С этой таблицей мы может выполнять какие-либо действия, например: Заменим все числа кратные 2 на 2, кратные 3 на 3, кратные 5 на 5, остальные на «*». Произведём подсчёт таких чисел. Для этого добавим строки:

‘Обработка таблицы

Dim Кратные2, Кратные3, Кратные5, Звезд As Integer

Кратные2 = 0

Кратные3 = 0

Кратные5 = 0

Звезд = 0

For i = 1 To 20

For j = 1 To 10

If A(i, j) \ 2 = A(i, j) / 2 Then Cells(i, j + 22) = 2

If A(i, j) \ 3 = A(i, j) / 3 Then Cells(i, j + 22) = 3

If A(i, j) \ 5 = A(i, j) / 5 Then Cells(i, j + 22) = 5

If A(i, j) \ 2 A(i, j) / 2 And A(i, j) \ 3 A(i, j) / 3 And A(i, j) \ 5 A(i, j) / 25 Then Cells(i, j + 22) = «*»

If A(i, j) \ 2 = A(i, j) / 2 Then Кратные2 = Кратные2 + 1 ‘Подсчёт количества чисел кратных 2

If A(i, j) \ 3 = A(i, j) / 3 Then Кратные3 = Кратные3 + 1 ‘Подсчёт количества чисел кратных 3

If A(i, j) \ 5 = A(i, j) / 5 Then Кратные5 = Кратные5 + 1 ‘Подсчёт количества чисел кратных 5

If Cells(i, j + 22) = «*» Then Звезд = Звезд + 1 ‘Подсчёт количества «*»

Next j

Next i

Range(«D22″).Value = «Таблица»

Range(«O22″).Value = «Копия Таблицы»

Range(«Z22″).Value = «Обработанная таблица»

Range(«W22″).Value = «Кратные 2″ ‘Вывод результатов

Range(«W23″).Value = «Кратные 3″

Range(«W24″).Value = «Кратные 5″

Range(«W25″).Value = «Кол-во *»

Range(«X22″).Value = Кратные2

Range(«X23″).Value = Кратные3

Range(«X24″).Value = Кратные5

Range(«X25″).Value = Звезд

Рис. 5. Обработанная таблица

Используя офисное программирование можно сформировать у студентов комплекс знаний, умений и навыков, необходимых для решения профессиональных задач в области автоматизации работы с офисным пакетом Microsoft Office.

Литература:

  1. И. Г. Фризен. Офисное программирование: Учебное пособие / М. Издательско-торговая корпорация «Дашков и К», 2013 г.
  2. Языки управления приложениями: Учебно-методическое пособие. — М.: Издательский отдел факультета ВМиК МГУ имени М. В. Ломоносова № 05899; 2015 г.
  3. https://studfiles.net/preview/2897110/
  4. https://www.intuit.ru/studies/courses/23/23/info

Основные термины (генерируются автоматически): VBA, массив, двумерный массив, Задание массива, Максимальный элемент, Начальное значение, программный код, размах таблицы, Число столбцов, Число строк.

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

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

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

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

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

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

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

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

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

Примеры поиска в огромных массивах:

Поиск с использованием ArrAutofilterEx

Sub ПримерМедленногоПоискаВМассиве()
    t = Timer
    ИскомоеЗначение$ = 560
    СтолбецДляПоиска& = 3
 
    ' загружаем массив с листа
    arr = [a1:d30000].Value
 
    ' укорачиваем массив Arr, оставляя лишь те строки,
    ' где в заданном столбце есть искомое значение
    On Error Resume Next: Err.Clear
    resArr = ArrAutofilterEx(arr, СтолбецДляПоиска& & "=" & ИскомоеЗначение$)
 
    ' проверяем возвращеное функцией значение на наличие результатов поиска
    If Err Then Debug.Print "Такие строки в массиве не найдены": Exit Sub
 
    ' выводим из отфильтрованных строк значения первого столбца
    For i = LBound(resArr) To UBound(resArr)
        Debug.Print "Результат - строка " & i & " из " & UBound(resArr) & ": ", resArr(i, 1)
    Next i
    Debug.Print "Время: " & Timer - t & " сек."
End Sub

Поиск с использованием ArraySearchResults

Sub ПримерБыстрогоПоискаВМассиве()
    t = Timer
    ИскомоеЗначение$ = 560
    СтолбецДляПоиска& = 3
 
    ' загружаем массив с листа
    arr = [a1:d30000].Value
 
    ' формируем строку поиска
    ss$ = SearchString(arr, СтолбецДляПоиска&)
 
    ' укорачиваем массив Arr, оставляя лишь те строки,
    ' где в заданном столбце есть искомое значение
    resArr = ArraySearchResults(arr, ss$, ИскомоеЗначение$)
 
    ' проверяем возвращеное функцией значение на наличие результатов поиска
    If Not IsArray(resArr) Then Debug.Print "Такие строки в массиве не найдены": Exit Sub
 
    ' выводим из отфильтрованных строк значения первого столбца
    For i = LBound(resArr) To UBound(resArr)
        Debug.Print "Результат - строка " & i & " из " & UBound(resArr) & ": ", resArr(i, 1)
    Next i
    Debug.Print "Время: " & Timer - t & " сек."
End Sub

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

Function ArraySearchResults(ByRef arr, ByRef searchStr As String, ByVal txt As String, _
                            Optional ByVal Sep As String = "%$%") As Variant
    ' функция получает в качестве параметров массив Arr,
    ' и заранее сформированную строку SearchString из значений ячеек нужного столбца массива
    ' По этой строке SearchString функция ищет строки массива, в которые встречается значение txt,
    ' и возвращает усечённый массив, содержащий только подходящие строки
    ' Поиск ведётся по ТОЧНОМУ совпадению значений

    ro& = 0: spl = Split(searchStr, Sep & txt & Sep)
    If UBound(spl) = 0 Then Exit Function    ' нет в массиве нужных строк
    ' перебираем результаты поиска, вычисляя номера строк в исходном массиве
    For i = LBound(spl) To UBound(spl) - 1
        txt = spl(i): ro& = ro& + 1 + (Len(spl(i)) - Len(Replace(spl(i), Sep, ""))) / Len(Sep) \ 2
        spl(i) = ro&
    Next i
    ' подготавливаем массив для результатов:
    ' по ширине - как исходный, по высоте - содержащий столько строк, сколько найдено совпадений
    ReDim resArr(1 To UBound(spl), LBound(arr, 2) To UBound(arr, 2))
    ' заполняем новый массив
    For i = LBound(spl) To UBound(spl) - 1
        For j = LBound(arr, 2) To UBound(arr, 2)
            resArr(i + 1, j) = arr(spl(i), j)
        Next j
    Next i
    ArraySearchResults = resArr
End Function
 
Function SearchString(ByRef arr, ByVal ArrayColumn As Long, _
                      Optional ByVal Sep As String = "%$%") As String
    ' Объединяет все значения из столбца ArrayColumn массива Arr в одну текстовую строку,
    ' в качестве разделителя элементов используя строку Sep
    ' Для ускорения конкатенации длинных строк используются
    ' промежуточные переменные buffer$ и buffer2$
    buffer$ = "": buffer2$ = "": Sep2$ = Sep$ & Sep$: Const BufferLen& = 6000
    On Error Resume Next: Err.Clear: SearchString = Sep2$
    If ArrayColumn > UBound(arr, 2) Or ArrayColumn < LBound(arr, 2) Then Exit Function
    For i = LBound(arr) To UBound(arr)
        buffer$ = buffer$ & Trim$(arr(i, ArrayColumn)) & Sep2$
        If Len(buffer$) > BufferLen& Then
            buffer2$ = buffer2$ & buffer$: buffer$ = ""
            If Len(buffer2$) > BufferLen& * 20 Then _
               SearchString = SearchString & buffer2$: buffer2$ = ""
        End If
    Next i
    SearchString = SearchString & buffer2$ & buffer$
End Function

При поиске только одного значения время работы обоих макросов поиска не сильно отличается — но обычно функция ArraySearchResults оказывается немного быстрее.

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

Функция ArraySwapColumns позволяет переставить в нужном порядке столбцы двумерного массива.
Кроме того, попутно можно изменить вторую размерность массива (чтобы убрать лишние столбцы, или добавить недостающие)

См. пример использования в прикреплённом файле.

Function ArraySwapColumns(ByVal arr As Variant, ByVal NewColumnsOrder$, _
                          Optional ByVal OptionBase As Integer = 1) As Variant
    ' функция принимает в качестве параметра двумерный массив arr
    ' (для перестановки столбцов)
    ' и текстовую строку NewColumnsOrder с новым порядком столбцов
    ' в формате ",,5,6,8,,9-15,18,2,9-11,,1,4,,21,"
    On Error Resume Next
    ColumnsArray = ParseColumnsString(NewColumnsOrder$)
    NewUBound% = UBound(ColumnsArray) + 1
 
    ReDim tmpArr(LBound(arr, 1) To UBound(arr, 1), LBound(arr, 2) To NewUBound%)
 
    For j = LBound(ColumnsArray) To UBound(ColumnsArray)
        OldColumn% = ColumnsArray(j) + 1 - OptionBase
        NewColumn% = j + LBound(arr, 2)
        If OldColumn% >= 0 Then
            For i = LBound(arr, 1) To UBound(arr, 1)    ' перенос столбца
                tmpArr(i, NewColumn%) = arr(i, OldColumn%)
            Next i
        End If
    Next j
    ArraySwapColumns = tmpArr
End Function
 
 
Function ParseColumnsString(ByVal txt$) As Variant
    ' Принимает в качестве параметра строку типа ",,5,6,8,,9-15,18,2,11-9,,1,4,,21,"
    ' Возвращает одномерный (горизонтальный) массив в формате
    ' array(-1,-1,5,6,8,-1,9,10,11,12,13,14,15,18,2,11,10,9,-1,1,4,-1,21,-1)
    ' (пустые значения заменяются на -1; диапазоны типа 9-15 и 17-13 раскрываются)
    arr = Split(Replace(txt$, " ", ""), ","): Dim n As Long: ReDim tmpArr(0 To 0)
    For i = LBound(arr) To UBound(arr)
        Select Case True
            Case arr(i) = "", Val(arr(i)) < 0
                tmpArr(UBound(tmpArr)) = -1: ReDim Preserve tmpArr(0 To UBound(tmpArr) + 1)
            Case IsNumeric(arr(i))
                tmpArr(UBound(tmpArr)) = arr(i): ReDim Preserve tmpArr(0 To UBound(tmpArr) + 1)
            Case arr(i) Like "*#-#*"
                spl = Split(arr(i), "-")
                If UBound(spl) = 1 Then
                    If IsNumeric(spl(0)) And IsNumeric(spl(1)) Then
                        For j = Val(spl(0)) To Val(spl(1)) Step IIf(Val(spl(0)) > Val(spl(1)), -1, 1)
                            tmpArr(UBound(tmpArr)) = j: ReDim Preserve tmpArr(0 To UBound(tmpArr) + 1)
                        Next j
                    End If
                End If
        End Select
    Next i
    On Error Resume Next: ReDim Preserve tmpArr(0 To UBound(tmpArr) - 1)
    ParseColumnsString = tmpArr
End Function

——————— добавлено позже ———————-
То же самое, но в виде одной функции:

Function SWAP(ByVal arr As Variant, ByVal NewColumnsOrder$) As Variant
    ' Функция принимает в качестве параметра двумерный массив arr (для перестановки столбцов)
    ' и текстовую строку NewColumnsOrder с новым порядком столбцов в формате ",,5,6,8,,9-15,18,2,9-11,,1,4,,21,"
    ' Возвращает массив, в котором столбцы переставлены в нужном порядке
    On Error Resume Next
    cols = Split(Replace(NewColumnsOrder$, " ", ""), ","): Dim n As Long: ReDim colArr(0 To 0)
    For i = LBound(cols) To UBound(cols)
        Select Case True
            Case cols(i) = "", Val(cols(i)) < 0
                colArr(UBound(colArr)) = -1: ReDim Preserve colArr(0 To UBound(colArr) + 1)
            Case IsNumeric(cols(i))
                colArr(UBound(colArr)) = cols(i): ReDim Preserve colArr(0 To UBound(colArr) + 1)
            Case cols(i) Like "*#-#*"
                spl = Split(cols(i), "-")
                If UBound(spl) = 1 Then
                    If IsNumeric(spl(0)) And IsNumeric(spl(1)) Then
                        For j = Val(spl(0)) To Val(spl(1)) Step IIf(Val(spl(0)) > Val(spl(1)), -1, 1)
                            colArr(UBound(colArr)) = j: ReDim Preserve colArr(0 To UBound(colArr) + 1)
                        Next j
                    End If
                End If
        End Select
    Next i
    ReDim Preserve colArr(0 To UBound(colArr) - 1)
    ColumnsArray = colArr
 
    ReDim tmpArr(LBound(arr, 1) To UBound(arr, 1), LBound(arr, 2) To UBound(ColumnsArray) + 1)
    For j = LBound(ColumnsArray) To UBound(ColumnsArray)
        If Val(ColumnsArray(j)) >= 0 Then
            For i = LBound(arr, 1) To UBound(arr, 1): tmpArr(i, j + LBound(arr, 2)) = arr(i, Val(ColumnsArray(j))): Next i
        End If
    Next j
    SWAP = tmpArr
End Function

Пример использования (для перeстановки столбцов на листе Excel)

Range("k1:o30").Value = SWAP(Range("a1:h40").Value, "2,5,1,,8")
  • 15613 просмотров

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

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

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

Функция 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
Function CombineArrays(Arr1 As Variant, Arr2 As Variant) As Variant
    'функция CombineArrays объединяет 2 двумерных массива ОДИНАКОВОЙ ШИРИНЫ в один массив
    '(второй массив "дописывается" ниже первого, путем добавления строк из второго массива в первый)
    'Функция возвращает массив той же ширины, что и исходные,
    'а вертикальная размерность возвращаемого массива равна сумме количества строк исходных массивов
    '
    'В случае, если один из массивов не задан, функция возвращает другой заданный массив (без изменений)
    'ВНИМАНИЕ: все размерности массивов 1 и 2 должны совпадать (кроме первой размерности - по высоте)
    'Подразумевается, что индексы массивов начинаются с 1 (директива Option Base 1)

 
    ' если один из параметров не является массивом, функция возвращает другой параметр (массив)
    If (Not IsArray(Arr1)) And IsArray(Arr2) Then CombineArrays = Arr2: Exit Function
    If (Not IsArray(Arr2)) And IsArray(Arr1) Then CombineArrays = Arr1: Exit Function
    ' если оба параметра функции не являются массивами
    If (Not IsArray(Arr2)) And (Not IsArray(Arr1)) Then
        Debug.Print "ОШИБКА: Оба переданных значения не являются массивами!"
        CombineArrays = Null: Exit Function
    End If
 
    ' проверяем совпадение размерностей массивов Arr1 и Arr2
    On Error Resume Next: Err.Clear
 
    If (LBound(Arr1, 2) <> LBound(Arr2, 2)) Or (UBound(Arr1, 2) <> UBound(Arr2, 2)) Then
        Debug.Print "ОШИБКА: Размерности массивов (по ширине) не совпадают"
        CombineArrays = Null: Exit Function
    End If
    If Err.Number = 9 Then
        Debug.Print "ОШИБКА: Один из массивов не является двумерным!"
        CombineArrays = Null: Exit Function
    End If
 
 
    ReDim arr(1 To UBound(Arr1, 1) + UBound(Arr2, 1), LBound(Arr1, 2) To UBound(Arr1, 2))
 
    For i = 1 To UBound(Arr1, 1)
        For j = LBound(Arr1, 2) To UBound(Arr1, 2)
            arr(i, j) = Arr1(i, j)
        Next
    Next
 
    For i = 1 To UBound(Arr2, 1)
        For j = LBound(Arr2, 2) To UBound(Arr2, 2)
            arr(i + UBound(Arr1, 1), j) = Arr2(i, j)
        Next
    Next
    CombineArrays = arr    ' возвращаем объединённый массив
End Function

Поиск подходящих строк в двумерном массиве

Данная функция ищет в массиве все строки, похдодящие под заданные критерии, и возвращает список номеров подходящих строк (через запятую)

Option Compare Text
 
Function ArrAutofilter(ByRef arr, ParamArray args() As Variant) As String
    ' получает по ссылке массив ARR для фильтрации
    ' и список критериев фильтрации в формате "3=некий текст" (номер столбца, "=", искомое значение)
    ' возвращает текстовую строку - список номеров подходящих строк (через запятую)
    Dim Index As Long, OK As Boolean, ComparedColumn As Long, res As String
 
    If Not IsArray(arr) Then MsgBox "Это не массив!", vbCritical, _
       "Ошибка в функции ArrAutofilter": Exit Function
 
    For Index = LBound(args) To UBound(args)    ' перебираем все параметры фильтрации
        If Not IsMissing(args(Index)) Then
            If GetAutofilterArgument(args(Index), ComparedColumn, res) Then
                If (ComparedColumn > UBound(arr, 2)) Or (ComparedColumn < LBound(arr, 2)) Then _
                   ArrAutofilter = ArrAutofilter & "В массиве нет столбца с номером " & _
                   ComparedColumn & vbNewLine
            Else
                ArrAutofilter = ArrAutofilter & "Неверно сформирована строка фильтрации: " & _
                                args(Index) & vbNewLine
            End If
        Else
            ArrAutofilter = ArrAutofilter & (Index + 1) & "-й аргумент фильтрации отсутствует" & _
                            vbNewLine
        End If
    Next Index
    If Len(ArrAutofilter) Then
        MsgBox ArrAutofilter, vbCritical, "Ошибка в функции ArrAutofilter"
        ArrAutofilter = "": Exit Function
    End If
 
    For i = LBound(arr, 1) To UBound(arr, 1)    ' перебираем все строки массива
        OK = True
        For Index = LBound(args) To UBound(args)    ' перебираем все параметры фильтрации
            ' получаем параметры фильтрации
            X = GetAutofilterArgument(args(Index), ComparedColumn, res)
            If Not (arr(i, ComparedColumn) Like res) Then OK = False: Exit For
        Next Index
        If OK Then ArrAutofilter = ArrAutofilter & "," & i
    Next i
    ArrAutofilter = Mid$(ArrAutofilter, 2)
End Function
 
Function GetAutofilterArgument(ByVal arg, ByRef col As Long, ByRef searchStr As String) As Boolean
    col = 0: searchStr = ""
    If UBound(Split(arg, "=")) < 1 Then Exit Function    ' нет знака =
    sCol = Split(arg, "=")(0): If Len(sCol) = 0 Or Not sCol Like String(Len(sCol), "#") Then _
                                  Exit Function  ' номер столбца не соответствует
    searchStr = Mid$(arg, Len(sCol) + 2): col = Val(sCol)
    If col > 0 Then GetAutofilterArgument = True
End Function
 
Sub ПримерИспользования()
    arr = shs.UsedRange.Value
    Debug.Print ArrAutofilter(arr, "2=Для мужчин", "4=Джинсы", "73=?*")
End Sub

Несколько изменённая функция — работает также, только возвращает результат в виде отфильтрованного массива:

Function ArrAutofilterEx(ByRef arr, ParamArray args() As Variant) As Variant
    ' получает по ссылке массив ARR для фильтрации
    ' и список критериев фильтрации в формате "3=некий текст" (номер столбца, "=", искомое значение)
    ' возвращает двумерный массив с подходящими строками
    Dim Index As Long, OK As Boolean, ComparedColumn As Long, res As String
 
    If Not IsArray(arr) Then MsgBox "Это не массив!", vbCritical, _
       "Ошибка в функции ArrAutofilter": Exit Function
 
    For Index = LBound(args) To UBound(args)    ' перебираем все параметры фильтрации
        If Not IsMissing(args(Index)) Then
            If GetAutofilterArgument(args(Index), ComparedColumn, res) Then
                If (ComparedColumn > UBound(arr, 2)) Or (ComparedColumn < LBound(arr, 2)) Then _
                   ArrAutofilter = ArrAutofilter & "В массиве нет столбца с номером " & _
                   ComparedColumn & vbNewLine
            Else
                ArrAutofilter = ArrAutofilter & "Неверно сформирована строка фильтрации: " & _
                                args(Index) & vbNewLine
            End If
        Else
            ArrAutofilter = ArrAutofilter & (Index + 1) & "-й аргумент фильтрации отсутствует" & _
                            vbNewLine
        End If
    Next Index
    If Len(ArrAutofilter) Then
        MsgBox ArrAutofilter, vbCritical, "Ошибка в функции ArrAutofilter"
        ArrAutofilterEx = "": Exit Function
    End If
 
    Dim coll As New Collection
    For i = LBound(arr, 1) To UBound(arr, 1)    ' перебираем все строки массива
        OK = True
        For Index = LBound(args) To UBound(args)    ' перебираем все параметры фильтрации
            ' получаем параметры фильтрации
            X = GetAutofilterArgument(args(Index), ComparedColumn, res)
            If Not (arr(i, ComparedColumn) Like res) Then OK = False: Exit For
        Next Index
        If OK Then coll.Add i
    Next i
 
    ' формируем новый массив
    ReDim newarr(1 To coll.Count, LBound(arr, 2) To UBound(arr, 2))
    For i = 1 To coll.Count
        ro = coll(i)
        For j = LBound(arr, 2) To UBound(arr, 2): newarr(i, j) = arr(ro, j): Next j
    Next i
 
    ArrAutofilterEx = newarr
End Function
 
Function GetAutofilterArgument(ByVal arg, ByRef col As Long, ByRef searchStr As String) As Boolean
    col = 0: searchStr = ""
    If UBound(Split(arg, "=")) < 1 Then Exit Function    ' нет знака =
    sCol = Split(arg, "=")(0): If Len(sCol) = 0 Or Not sCol Like String(Len(sCol), "#") Then _
                                  Exit Function  ' номер столбца не соответствует
    searchStr = Mid$(arg, Len(sCol) + 2): col = Val(sCol)
    If col > 0 Then GetAutofilterArgument = True
End Function

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

Sub FilterExample()
    On Error Resume Next
    Dim arr As Variant
 
    ' отбираем только нужные строки из диапазона a2:t200,
    ' где текст в третьем столбце начинается с "asy"
    arr = ArrAutofilterEx(Range("a2:t200").Value, "3=asy*")
 
    ' создаем лист, вставляем на него результат
    Worksheets.Add.Range("a1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

Программирование Excel VBA — многомерные массивы

Массивы в нашем последнем уроке были
все одномерные массивы. Он одномерный, потому что есть только один столбец
пунктов. Но у вас могут быть массивы с более чем одним измерением. Теоретически вы
может иметь массив до 60 измерений в Excel VBA. Однако вы
будьте рады узнать, что это редкая программа, которая использует более трех измерений,
или даже 2 измерения.

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

Dim MyArray (5, 4) как целое число

Или так:

Dim MyArray (от 1 до 5, от 1 до 6) как целое число

Во втором объявлении выше мы указали, что позиции массива должны
начать с 1, а не с 0.

Массивы выше — это двухмерные массивы. Если вы хотите добавить еще одно измерение,
просто добавьте еще одну запятую и еще одно число:

Dim MyArray (5, 4, 6) как целое число
Dim MyArray (от 1 до 5, от 1 до 4, от 1 до 6) как целое число

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

Создайте новый Sub и назовите его ArrayExercise_3 . (Вы можете использовать свою электронную таблицу
из предыдущего урока, если хотите.)
В качестве первой строки кода добавьте эту строку:

Dim MyArray (2, 3) как целое число

Устанавливает двумерный массив. Думайте об этом как о строках и столбцах в вашей электронной таблице.
2 означает 3 строки (помните, от 0 до 2). 3 означает 4 столбца.

Чтобы сохранить данные в первой строке, добавьте эти строки:

MyArray (0, 0) = 10
MyArray (0, 1) = 10
MyArray (0, 2) = 10
MyArray (0, 3) = 10

Это означает, что строка 0, столбец 0 имеет значение 10, строка 0, столбец 1 имеет значение
10, столбец 2 строки 0 имеет значение 10, а столбец 3 строки 0 имеет значение 10.

Конечно, в электронной таблице нет строки или столбца 0, и вы увидите, как
мы решаем это в цикле. А пока добавьте значения для других позиций в
2-мерные массивы:

MyArray (1, 0) = 20
MyArray (1, 1) = 20
MyArray (1, 2) = 20
MyArray (1, 3) = 20
MyArray (2, 0) = 30
MyArray (2, 1) = 30
MyArray (2, 2) = 30
MyArray (2, 3) = 30

Новые строки добавляют значения к остальным позициям в массиве.

Чтобы пройти все позиции в 2-D, вам понадобится двойная петля. Двойная петля
означает один цикл внутри другого. Внешний цикл заботится о строках, а
внутренний цикл заботится о столбцах. (Строки — это первые позиции между
круглые скобки MyArray , а столбец — вторые позиции
между круглыми скобками MyArray )

Для цикла, внешнего цикла добавьте это:

Для i = от 0 до 2

Далее i

Теперь вам нужен внутренний цикл, выделенный ниже полужирным шрифтом:

Для i = от 0 до 2

Для j = от 0 до 3

Далее j

Далее i

Переменная для внутреннего цикла — j , а не i .Но они
— это просто имена переменных, поэтому мы могли бы называть их почти как угодно.
Также обратите внимание, что внешний цикл идет от 0 до 2, а внутренний цикл идет
от 0 до 3. Они соответствуют числам в круглых скобках MyArray.
когда мы его настраиваем.

Код цикла следующий, но он должен идти между For и Next.
внутреннего цикла:

Ячейки (i + 1, j + 1). Значение = MyArray (i, j)

Это довольно сложно, поэтому мы рассмотрим его.Взгляните на часть Cells:

Ячейки (i + 1, j + 1)

Поскольку наши массивы настроены на начало с 0, нам нужно добавить 1 к i и
Дж . Если бы мы этого не сделали, то при первом обходе цикла значения были бы
быть такими:

Ячейки (0, 0)

Это приведет к ошибке, поскольку в таблице Excel нет строки 0 и столбца 0.

На случай, если вам интересно, почему первый раз цикл дает значения
0, 0 для ячеек, вот объяснение.

Первая строка внешнего цикла — это еще один цикл. Это означает, что весь
внутренний цикл будет выполняться от 0 до 3. Затем VBA перейдет к Next i
линия. Следующие i после 0 — 1. Конечное условие для внешнего цикла,
однако это 2, так что мы еще не закончили с внешним циклом. Так что снова он падает
вниз, чтобы выполнить свой код. Его код просто является внутренним циклом, поэтому он
снова выполняет весь этот внутренний цикл. Другими словами, внешний цикл
повторяется от 0 до 2 раз.Пока он крутится, он
так уж случилось, что он запустит внутренний цикл от 0 до 3 раз.

В первый раз значения во внутреннем цикле будут:

0, 0
0, 1
0, 2
0, 3

Во второй раз во внутреннем цикле значения для i и j будут
быть:

1, 0
1, 1
1, 2
1, 3

В третий раз будет:

2, 0
2, 1
2, 2
2, 3

Итак, первое число, то есть i , каждый раз увеличивается на 1.Эти
ряды. Второе число, j , всегда будет 0, 1, 2, а затем 3 (столбцы).

Обратите внимание, что после знака равенства в строке Cells мы имеем следующее:

= MyArray (i, j)

i и j между круглыми скобками MyArray будут
совпадать с числами выше.

Но весь ваш код должен выглядеть так:

Запустите код и посмотрите, что произойдет.Вернитесь к своей таблице, и вы
должно увидеть это:

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

В следующем уроке мы рассмотрим функцию Split и то, как
это относится к массивам.

Функция разделения VBA в Excel>

Множество бесплатных онлайн-курсов здесь, на нашем основном сайте Home and Learn

© Авторские права на все материалы курса принадлежат Кен Карни

.

измерений массива — Visual Basic

  • 3 минуты на чтение

В этой статье

Размер — это направление, в котором вы можете изменять спецификацию элементов массива. Массив, содержащий общую сумму продаж за каждый день месяца, имеет одно измерение (день месяца).Массив, содержащий общий объем продаж по отделам для каждого дня месяца, имеет два измерения (номер отдела и день месяца). Число измерений массива называется его рангом .

Примечание

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

Работа с размерами

Вы указываете элемент массива, предоставляя индекс или индекс для каждого из его измерений.Элементы непрерывны по каждому измерению от индекса 0 до самого высокого индекса для этого измерения.

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

Одно измерение

Многие массивы имеют только одно измерение, например количество людей каждого возраста.Единственное требование для указания элемента — это возраст, для которого этот элемент содержит счет. Следовательно, такой массив использует только один индекс. В следующем примере объявляется переменная для хранения одномерного массива счетчиков возрастов от 0 до 120.

  Dim ageCounts (120) As UInteger
  

Два измерения

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

  Dim officeCounts (40, 5) как байт
  

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

Три измерения

Некоторые массивы имеют три измерения, например значения в трехмерном пространстве. Такой массив использует три индекса, которые в данном случае представляют координаты x, y и z физического пространства.В следующем примере объявляется переменная для хранения трехмерного массива температур воздуха в различных точках трехмерного объема.

  Приглушенная температура воздуха (99, 99, 24) как одиночная
  

Более трех измерений

Хотя массив может иметь до 32 измерений, редко бывает больше трех.

Примечание

Когда вы добавляете измерения в массив, общий объем памяти, необходимый для массива, значительно увеличивается, поэтому используйте многомерные массивы с осторожностью.

Использование разных размеров

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

  Тусклые продажиКоличество (30) как двойное
  

Теперь предположим, что вы хотите отслеживать одну и ту же информацию не только для каждого дня месяца, но и для каждого месяца в году. Вы можете объявить двумерный массив с 12 строками (для месяцев) и 31 столбцом (для дней), как показано в следующем примере.

  Тусклые продажиКоличество (11, 30) как двойное
  

Теперь предположим, что вы решили хранить информацию в массиве более одного года. Если вы хотите отслеживать объем продаж за 5 лет, вы можете объявить трехмерный массив с 5 слоями, 12 строками и 31 столбцом, как показано в следующем примере.

  Тусклые продажи Количество (4, 11, 30) как двойное
  

Обратите внимание: поскольку каждый индекс изменяется от 0 до максимального, каждое измерение salesAmounts объявляется как длина на единицу меньше требуемой для этого измерения.Также обратите внимание, что размер массива увеличивается с каждым новым измерением. Три размера в предыдущих примерах — 31, 372 и 1860 элементов соответственно.

Примечание

Вы можете создать массив без использования оператора Dim или предложения New . Например, вы можете вызвать метод CreateInstance, или другой компонент может передать вашему коду массив, созданный таким образом. Такой массив может иметь нижнюю границу, отличную от 0. Вы всегда можете проверить нижнюю границу измерения с помощью метода GetLowerBound или функции LBound .

См. Также

.

массивов VBA — многомерные

многомерные массивы

Вы можете объявлять массивы с любым количеством измерений, которое вам нужно, даже если оно превышает 20, хотя у вас, вероятно, не будет более 3 или 4 максимумов.
Многомерные массивы могут иметь до 60 измерений.
Очень необычно использовать более двух или трех измерений.
При использовании двумерных массивов всегда есть столбцы и строки (т.е. (1,1) (1,2) (1,3) и т. Д.).
Можно ли иметь vArrayName (1, 2, 1) в многомерном массиве, когда он двумерный ???

Фиксированные массивы

Многомерный фиксированный массив объявляется с помощью оператора Dim.

 Dim aCellValues ​​(от 1 до 10, 1 до 100) как строка 

Это двумерный массив, первый индекс которого находится в диапазоне от 1 до 10, а второй индекс — от 1 до 100.

 aCellValues ​​(2,3) = "some text" 

Dynamic Arrays

Многомерный динамический массив должен быть объявлен в двух строках

 Dim aNumbers () As Integer 
ReDim aNumbers (от 1 до 10, от 1 до 100)

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

 Dim sCellValues ​​(от 1 до 50, от 1 до 10) как строка 

ReDim aCellValues ​​(от 1 до 50, от 1 до 20)
ReDim aCellValues ​​(от 1 до 50, от 1 до 20) как строка

Сохранение значений

Если вы используете ключевое слово Preserve, вы не можете изменить количество измерений.
Если вы используете ключевое слово Preserve, вы можете изменить размер только последнего измерения.

Функция массива

Для получения дополнительных сведений см. Страницу Функция массива .
Вы также можете определять и инициализировать многомерные массивы.

 Dim vArray As Variant 
vArray = Array (Array ("one"), Array ("Two"), Array ("three"), Array ("four"))

Ограничения

Большим недостатком использования многомерного массива является то, что все измерения должны содержать один и тот же тип данных.
Типы, определяемые пользователем может объединять несколько типов данных в один тип данных.
Вместо этого вы можете использовать определенный пользователем тип, когда вам нужно хранить значения с разными типами данных.


© 2020 Better Solutions Limited. Все права защищены. © 2020 Better Solutions Limited TopPrevNext.

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *