mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

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

Функция предназначена для получения двумерного массива данных из видимых строк листа 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
Подтвердите, пожалуйста, что вы - человек:
   ____   _   _   _____   ____    _____   ___  
/ ___| | | | | | ___| | _ \ |__ / / _ \
| | _ | |_| | | |_ | |_) | / / | | | |
| |_| | | _ | | _| | __/ / /_ | |_| |
\____| |_| |_| |_| |_| /____| \__\_\
Введите код, изображенный в стиле ASCII-арт.

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

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