Функция предназначена для получения двумерного массива данных из видимых строк листа 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
Комментарии
Спасибо конечно, но эта ерунда совсем не работает. Зачем публиковать не работоспособный код?
В частности вот здесь ошибка:
Set ra3 = Intersect(sh.Range(FirstRow& & ":" & sh.Rows.Count),
Добрый день.
Да, столкнулся с такой же проблемой. Причем, не важно есть фильтр или нет. Если в отфильтрованном списке только одна строка и она именно 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
Отправить комментарий