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

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

 

Например, нас интересует массив, начиная со второй строки, шириной 5 столбцов.

Если все строки на листе - видимые, то все делается просто, одной строкой кода:

arr = Range(Range("a2"), Range("a" & Rows.Count).End(xlUp)).Resize(, 5).Value 

 

А если на листе включен автофильтр (некоторые строки скрыты), а нам надо получить в массиве данные только из видимых строк?

Тогда на помощь придет функция GetVisibleRowsArray:

arr = GetVisibleRowsArray(ActiveSheet, 2, 1, 5)

 

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

Function GetVisibleRowsArray(ByRef sh As Worksheet, ByVal FirstRow&, _
                             Optional ByVal CheckColumn& = 1, Optional ByVal ColumnsCount& = 0) As Variant
    ' Функция возвращает двумерный массив с данными с листа sh
    ' В массив попадают все ВИДИМЫЕ строки, после строки номер FirstRow&,
    ' до последней строки, у которой в столбце CheckColumn& непустое значение.
    ' Ширину массива можно задать в параметре ColumnsCount&
    ' (если ширина массива не задана, она определяется автоматически)

    On Error Resume Next
    Dim ra As Range, ra2 As Range, ra3 As Range, ar As Range, rc&, ind&
    Set ra2 = sh.Range(sh.Cells(FirstRow&, CheckColumn&), sh.Cells(sh.Rows.Count, CheckColumn&).End(xlUp))
    If ra2.Row < FirstRow& Then Exit Function    ' нет ни одной видимой строки после строки FirstRow&

    If ColumnsCount& <= 0 Then ColumnsCount& = sh.UsedRange.Columns.Count
    Set ra3 = Intersect(sh.Range(FirstRow& & ":" & sh.Rows.Count), ra2.SpecialCells(xlCellTypeVisible)).EntireRow
    Set ra = Intersect(ra3, sh.Cells(1).Resize(, ColumnsCount&).EntireColumn)
 
    For Each ar In ra.Areas: rc& = rc& + ar.Rows.Count: Next    ' подсчитываем кол-во видимых строк
    ReDim arr(1 To rc&, 1 To ColumnsCount&)
 
    For Each ar In ra.Areas
        ararr = "": If ar.Columns.Count = 1 Then ararr = ar.Resize(, 2).Value Else ararr = ar.Value
        For i& = LBound(ararr) To UBound(ararr)
            ind& = ind& + 1
            For j& = 1 To ColumnsCount&: arr(ind&, j&) = ararr(i&, j&): Next j&
        Next i
    Next
 
    GetVisibleRowsArray = arr
End Function

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Добрый день.
Да, столкнулся с такой же проблемой. Причем, не важно есть фильтр или нет. Если в отфильтрованном списке только одна строка и она именно FirstRow& (в моем случае = 11) то размер массива берется максимальное количество строк.
Родскажите, пожалуйста, как можно с этим справится?
Спасибо.

День добрый.
Подскажите, пожалуйста, по функции.
Наткнулся на баг с определением массива.
Если в массив должна попасть только одна строка, тоесть нет никаких фильтров, на листе, то он берет, как размер массива, максимальное количество строк.
Как начальные параметры массива стоят
FirstRow = 13 'start row for array
ColumnsCount = 11 'number of columns for array
CheckColumn = 2 'start clolumn for array

Function GetVisibleRowsArray(ByRef sh As Worksheet, ByVal FirstRow&, _
Optional ByVal CheckColumn& = 1, Optional ByVal ColumnsCount& = 0) As Variant
On Error Resume Next
Dim ra As Range, ra2 As Range, ra3 As Range, ar As Range, rc&, ind&
Set ra2 = sh.Range(sh.Cells(FirstRow&, CheckColumn&), sh.Cells(sh.Rows.Count, CheckColumn&).End(xlUp))
If ra2.row < FirstRow& Then Exit Function

If ColumnsCount& <= 0 Then ColumnsCount& = sh.UsedRange.Columns.Count
Set ra3 = Intersect(sh.Range(FirstRow& & ":" & sh.Rows.Count), ra2.SpecialCells(xlCellTypeVisible)).EntireRow
Set ra = Intersect(ra3, sh.Cells(2).Resize(, ColumnsCount&).EntireColumn) ' 2 - начальная колонка

For Each ar In ra.Areas: rc& = rc& + ar.Rows.Count: Next
ReDim arr(1 To rc&, 1 To ColumnsCount&)

For Each ar In ra.Areas
ararr = "": If ar.Columns.Count = 1 Then ararr = ar.Resize(, 2).Value Else ararr = ar.Value
For i& = LBound(ararr) To UBound(ararr)
ind& = ind& + 1
For j& = 1 To ColumnsCount&: arr(ind&, j&) = ararr(i&, j&): Next j&
Next i
Next
GetVisibleRowsArray = arr
End Function

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _       _   _           ___  __     __  _   
| |__ | | | | __ _ |_ _| \ \ / / | |_
| '_ \ | | | | / _` | | | \ \ / / | __|
| | | | | |_| | | (_| | | | \ V / | |_
|_| |_| \___/ \__, | |___| \_/ \__|
|___/
Введите код, изображенный в стиле ASCII-арт.

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

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