VBA: Работа с отфильтрованными строками и SpecialCells (xlCellTypeVisible) против копирования данных на новый лист

Question

У меня есть книга Excel с 250 000 строк и 10 столбцов, и я хочу разделить данные на разные книги.Моя идея состояла в том, чтобы отфильтровать список, чтобы Excel / VBA не проходил все 250 000 строк каждый раз, когда мой код говорит что-то искать в данных.

Однако я столкнулся с одной конкретной проблемой с Sort, а также с общим вопросом о скрытых строках и SpecialCells(xlCellTypeVisible).Во-первых, вот код:

Option Explicit

Sub Filtering()
   Dim wsData As Worksheet
   Dim cell As Variant
   Dim lRowData As Long, lColData As Long

'filter
   Set wsData = ThisWorkbook.Sheets(1)
   lRowData = wsData.Cells(Rows.Count, 1).End(xlUp).Row
   wsData.Range("A:A").AutoFilter Field:=1, Criteria1:="Name1"
   For Each cell In wsData.Range(wsData.Cells(2, 1), wsData.Cells(100, 1)).SpecialCells(xlCellTypeVisible)
       Debug.Print cell.Value 
   Next cell

'sort
   lColData = wsData.Cells(1, Columns.Count).End(xlToLeft).Column   
   wsData.Range(wsData.Cells(1, 1), wsData.Cells(lRowData, lColData)).SpecialCells(xlCellTypeVisible).Sort Key1:=wsData.Range("B1:B100"),   Order1:=xlDescending, Header:=xlYes ' returns error because of SpecialCells

End Sub

1. «Ошибка времени выполнения« 1004 »: это невозможно сделать при выборе нескольких диапазонов. Выберите один диапазон и повторите попытку».Это происходит в последней строке, в wsData.Range(wsData.Cells(1, 1), wsData.Cells(lRowData, lColData)).SpecialCells(xlCellTypeVisible).Sort Key1:=wsData.Range("B1:B100"), Order1:=xlDescending, Header:=xlYes.Это происходит только тогда, когда я использую SpecialCells(xlCellTypeVisible), поэтому wsData.Range(wsData.Cells(1, 1), wsData.Cells(lRowData, lColData)).Sort Key1:=wsData.Range("B1:B100"), Order1:=xlDescending, Header:=xlYes работает.

Я думал об использовании SpecialCells(xlCellTypeVisible), что только тогда VBA пропустит отфильтрованные ячейки.Я попробовал это, однако, и мне кажется, что .Sort пропускает их в любом случае, с * 1017 или без * - кто-то может это подтвердить?

И это приводит к моему более общему вопросу: мне не совсем ясно, когда Excel / VBA пропускает отфильтрованные строки, а когда нет.Чтобы перебрать видимые ячейки, мне нужно использовать SpecialCells(xlCellTypeVisible).С .Sort я (может быть) не?И этот вопрос всегда будет всплывать при любой операции, которую я буду выполнять в этих отфильтрованных списках.

Это заставило меня задуматься: работать ли мне с исходным листом, где часть данных скрыта, или временно создавать новый лист, копировать только те данные, которые мне нужны (= исключая строки I 'спрятал с фильтром) а потом работать с этим?Будет ли этот новый лист быстрее или проще?Что лучше в вашем опыте?

Answer 1

1. Первая ошибка возникает при попытке скопировать несмежные ячейки или выбранные диапазоны, например, несколько несмежных строк в одном столбце (A1, A3, A5).Это связано с тем, что Excel «сдвигает» диапазоны вместе и вставляет их в один прямоугольник.Ваши видимые специальные ячейки не являются смежными, и поэтому не могут быть скопированы как один диапазон.

2. Кажется, что Excel просматривает все ячейки в вашем диапазоне, а не только видимыеиз них.Ваш debug.print возвращает больше строк, чем только видимых.

Я бы использовал другой подход к решению вашей проблемы с помощью массивов, которые VBA способен обходить чрезвычайно быстро.по сравнению с электронными таблицами.

Используя этот подход, я смог скопировать 9 тыс. строк с 10 столбцами на основе значения первого столбца из размера выборки 190 тыс. за 4,55 секунды:

РЕДАКТИРОВАТЬ: Я немного возился с массивами, которые сократили время до 0,45 секунд, чтобы скопировать 9k строк на основе первого столбца из начальных 190k, используя следующее:

Option Explicit

Sub update_column()

Dim lr1 As Long, lr2 As Long, i As Long, j As Long, count As Long, oc_count As Long
Dim arr As Variant, out_arr As Variant
Dim start_time As Double, seconds_elapsed As Double
Dim find_string As String

start_time = Timer

' change accordingly
find_string = "looking_for"

With Sheets("Sheet1")

    ' your target column in which you're trying to find your string
    lr1 = .Cells(Rows.count, "A").End(xlUp).Row
    lr2 = 1

    ' all of your data - change accordingly
    arr = .Range("A1:J" & lr1)

    ' get number of features matching criteria to determine array size
    oc_count = 0
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) = find_string Then
            oc_count = oc_count + 1
        End If
    Next

    ' redim array
    ReDim out_arr(oc_count, 9)

    ' write all occurrences to new array
    count = 0
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) = find_string Then
            For j = 1 To 10:
                out_arr(count, j - 1) = arr(i, j)
            Next j
            count = count + 1
        End If
    Next

    ' write array to your target sheet, change sheet name and range accordingly
    Sheets("Sheet2").Range("A1:J" & (oc_count + 1)) = out_arr

End With

seconds_elapsed = Round(Timer - start_time, 2)
Debug.Print (seconds_elapsed)

End Sub

Это не очень чисто и, вероятно, может быть сделано с некоторой очисткой, но если важна скорость (что часто кажется), это должно хорошо сработать для вас.

Answer 2

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

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

(слегка адаптированный) приведенный ниже код Дэвида Земенса будет хорошей отправной точкой (скопировано из Найти все экземпляры в столбце Excel )

Sub foo()

Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range

Set huntRange = Range("A:B")
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:="January", after:=LastCell, LookIn:=xlValues)

If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
    Do
        'Do your actions here, you can get the address of the found cell to return row etc.
        MsgBox (FoundCell.Value)
        Set FoundCell = myRange.FindNext(FoundCell)

    Loop While (FoundCell.Address <> FirstFound)
End If

Set rng = FoundCell  '<~~ Careful, as this is only the LAST instance of FoundCell.

End Sub