Страницы: 1
RSS
Пополнение массива из отфильтрованного диапазона
 
Добрый день Уважаемые Эксперты.

Позвольте у Вас уточнить возможно ли заполнение массива из отфильтрованного диапазона,
по технологии подобной следующей:
Код
A = Range("A2:A26").SpecialCells(xlCellTypeVisible)
В принципе массив заполняется, но только до наступления фильтра.
В кратце о диапазоне(диапазон довольно прост, в нем есть числа 1 2 3 4 5, каждое повторяется по 5 раз. Фильтром исключено число 4.
Вот мой вариант кода:

Код
Sub Popolnenie_Otfiltrovannym()
Dim A() As Variant

' Проверка копированием
Range("A2:A26").SpecialCells(xlCellTypeVisible).Copy
Range("H30").Select
ActiveSheet.Paste

' Проверка копированием
A = Range("A2:A26").SpecialCells(xlCellTypeVisible)[E30].Resize(UBound(A)).Value = A
End Sub
Копирование проходит правильно, а массив же заполняется только до наступления фильтра.
В общем подскажите массив вообще возможно заполнять методом :
Код
.SpecialCells(xlCellTypeVisible)
Если без дополнительных манипуляций не возможно тогда:
- или циклическое заполнение массива
- или предварительное копирование в другое место с отключением фильтра( или копирование на другой лист) с заполнением массива
- или помещение в массив всей базовой выборки с дальнейшей фильтрацией массива функцией Filter.

Прошу помочь разобраться.

Благодарю Вас.
 
Цитата
В общем подскажите массив вообще возможно заполнять методом :
Код
.SpecialCells(xlCellTypeVisible)
По ходу нет.
Тут
Изменено: skais675 - 20.02.2019 10:44:40
 
У меня только циклом получается
с условием Rows().Hidden = False
Изменено: magistor8 - 20.02.2019 10:50:02
 
А если загнать все в массив и по условию перезаписать, а потом выгрузить на лист? Такой способ не пробовали?
Пример:
Скрытый текст
Изменено: Nordheim - 20.02.2019 13:36:17
"Все гениальное просто, а все простое гениально!!!"
 
здравствуйте!
Цитата
IgorBoot: заполнение массива из отфильтрованного диапазона
ну, во-первых, вы забыли ".Value" или ".Value2" в конце. Во-вторых: НЕТ (к сожалению) — махом забрать в массив "рваный" диапазон нельзя.

Варианты: 1. "В ЛОБ": цикл по областям
Из диапазона в одномерный массив
2. вариант от Nordheim - самый быстрый. К слову, я такой же принцип использую для удаления строк. Общий принцип - забрать всё в массив, удалить все строки обычного диапазона или умной таблицы, "отфильтровать" массив в памяти. выгрузить отфильтрованный массив обратно на лист. Скорость подробно не замерял, но, на примере моих таблиц заметнор быстрее прогрессивных методов от ZVI (а это значит очень быстро) типа "создай столбец с признаком + отсортируй по нему + удали N строк от 2ой строки + удали столбец с признаком"
Изменено: Jack Famous - 20.02.2019 15:43:38
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
... и следующий вариант:
Код
Option Explicit

Sub Makros1()
    Dim i&, j%, indR&, indC%, tbl()
    Dim rRng As Range, sngArea As Range, rowRng As Range
    
    Application.ScreenUpdating = False
    With ActiveSheet
        With .Range("A1").CurrentRegion
            indR = .Rows.Count - 1: indC = .Columns.Count
            .AutoFilter Field:=1, Criteria1:="<>4"
            Set rRng = .Offset(1, 0).Resize(indR, indC).SpecialCells(xlCellTypeVisible)
            .AutoFilter
            indR = 0: indC = 0
            For Each sngArea In rRng.Areas
                indR = indR + sngArea.Rows.Count
            Next
            indC = rRng.Columns.Count
            ReDim tbl(1 To indR, 1 To indC)
            For j = 1 To indC
                i = 0
                For Each rowRng In rRng.Rows
                    i = i + 1: tbl(i, j) = rowRng.Cells(j).Value
                Next
            Next
        End With
        .Range("D1").Resize(indR, indC).Value = tbl
        Erase tbl
    End With
    Application.ScreenUpdating = True
End Sub
 
Ну, если цель - обойтись без цикла, то можно, например, так:
Код
Sub Popolnenie_Otfiltrovannym()
    Dim x As Range, a()
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    Set x = Range("A2:A26").SpecialCells(xlCellTypeVisible)
    Sheets.Add: x.Copy [A1]
    a = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    ActiveSheet.Delete
    [E30].Resize(UBound(a)).Value = a
End Sub
В любом случае, для предотвращения ошибок, потребуются дополнительные проверки.
Во-первых, что делать, если в результате применения автофильтра, в рабочем диапазоне не нашлось ни одной видимой ячейки?
Во-вторых, что делать, если  в результате применения автофильтра, в рабочем диапазоне всего одна видимая ячейка? Сформировать массив в таком случае не получится.
Чем шире угол зрения, тем он тупее.
Страницы: 1
Наверх