VBA:处理已过滤的行和SpecialCells(xlCellTypeVisible)与将数据复制到新表中 [英] VBA: Working with filtered rows and SpecialCells(xlCellTypeVisible) vs copying data into new sheet

问题描述

我有一个包含250,000行和10列的Excel工作簿，我想将数据拆分为不同的工作簿.我的想法是过滤列表，以使Excel/VBA不必每次我的代码说要在数据中查找内容时都遍历所有250,000行.

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.

但是，我遇到了Sort的一个特定问题，并且对隐藏行和SpecialCells(xlCellTypeVisible)也有一个一般性的问题.首先，这是代码:

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. 运行时错误'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可以工作.

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.

在使用SpecialCells(xlCellTypeVisible)时，我的想法是只有VBA才会跳过过滤的单元格.不过，我已经尝试过了，在我看来，无论是否使用SpecialCells(xlCellTypeVisible)，.Sort都会跳过它们-有人可以确认吗?

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?

1. 这导致了我的更笼统的问题:我不清楚的一件事是Excel/VBA何时跳过过滤的行，什么时候不跳过.要遍历可见的单元格，我需要使用SpecialCells(xlCellTypeVisible).使用.Sort我(也许)不会吗?对于我将在这些过滤列表上执行的任何操作，此问题将始终弹出.

1. 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?

推荐答案

1. 当您尝试复制不相邻的单元格或范围选择(例如，同一列(A1，A3，A5)中的多个不相邻的行)时，会发生第一个错误.这是因为Excel将范围滑动"在一起并将其粘贴为单个矩形.您可见的特殊单元格不相邻，因此不能复制为单个范围.

1. Your first error occurs when you attempt to copy nonadjacent cell or range selections e.g 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.

似乎excel遍历了您范围内的所有单元，而不仅仅是可见的单元.您的debug.print返回的行比可见行还要多.

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.

我将通过使用数组来解决您的问题，与工作表相比，VBA可以非常快速地遍历数组.

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.

使用这种方法，我能够在4.55秒的时间内从190k的样本大小中基于第一列的值复制10列的9k行:

编辑:我对数组进行了一些弄乱，使用以下命令将时间从最初的190k复制到0.45秒，从第一列开始复制9k行减少了0.45秒:

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.

这篇关于VBA:处理已过滤的行和SpecialCells(xlCellTypeVisible)与将数据复制到新表中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！