VBA：处理过滤的行和SpecialCells（xlCellTypeVisible）与将数据复制到新表中

Question

I have an Excel workbook with 250,000 rows and 10 columns and I want to split up the data into different workbooks. My idea was to filter the list so that Excel/VBA doesn't have to go through all 250,000 rows every time my code says to look for something in the data.

However, I've run into one specific problem with Sort and also have a general question regarding hidden rows and SpecialCells(xlCellTypeVisible) . First off, here's the code:

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. "Run-time error '1004': This can't be done on a multiple range selection. Select a single range and try again." This occurs in the last line, in wsData.Range(wsData.Cells(1, 1), wsData.Cells(lRowData, lColData)).SpecialCells(xlCellTypeVisible).Sort Key1:=wsData.Range("B1:B100"), Order1:=xlDescending, Header:=xlYes . It only happens when I use SpecialCells(xlCellTypeVisible) , so wsData.Range(wsData.Cells(1, 1), wsData.Cells(lRowData, lColData)).Sort Key1:=wsData.Range("B1:B100"), Order1:=xlDescending, Header:=xlYes works.

My thinking in using SpecialCells(xlCellTypeVisible) was that only then VBA would skip the filtered cells. I've tried it out, though, and to me it seems .Sort skips them anyway, with or without SpecialCells(xlCellTypeVisible) - can someone confirm this?

2. And this leads to my more general question: One thing I'm not quite clear on is when does Excel/VBA skip filtered rows and when it doesn't. To loop through the visible cells, I need to use SpecialCells(xlCellTypeVisible) . With .Sort I (maybe) don't? And this question will always pop up for any operation I'll do on these filtered lists.

This made me wonder: should I work with my original sheet where part of the data is hidden or should I temporarily create a new sheet, copy only the data I need (= excluding the rows I've hidden with the filter) and then work with that? Would this new sheet make it quicker or easier in any way? What is better in your experience?

Answer 1

1. Your first error occurs when you attempt to copy nonadjacent cell or range selections eg multiple nonadjacent rows within the same column (A1, A3, A5). This is because Excel "slides" the ranges together and pastes them as a single rectangle. Your visible special cells are nonadjacent, and therefore can't be copied as a single range.

2. It seems that excel is looping through all of the cells in your range, not just the visible ones. Your debug.print is returning more rows than just those that are visible.

I would take a different approach to tackling your problem by using arrays, which VBA is able to loop through extremely quickly compared to worksheets.

Using this approach, I was able to copy 9k rows with 10 columns based on the value of the first column from a sample size of 190k in 4.55 seconds:

EDIT: I did some messing around with the arrays which brought the time down to 0.45 seconds to copy 9k rows based on the first column from an initial 190k using the following:

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

It isn't super clean and could probably do with some refining, but if speed is important (which it often seems to be), this should do the job well for you.

Answer 2

As per bm13563 comment you are copying nonadjacent cells. Also using a Sort will be altering your base data which could have an impact if you ever need to determine how it was initially ordered in the future.

Working with filters can become quite complex so a simpler (and not particularly slow) method could be to do a string search with your filtering value in your chosen column and then loop through the instances returned performing actions on each result.

The (slightly adapted) code below from David Zemens would be a good starting point (copied from Find All Instances in Excel Column )

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