VBA：使用过滤的行和 SpecialCells(xlCellTypeVisible) 与将数据复制到新工作表中

我有一个包含 250,000 行和 10 列的 Excel 工作簿，我想将数据拆分到不同的工作簿中。我的想法是过滤列表，以便 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), 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 才会跳过过滤的单元格。不过我已经尝试过了，对我来说似乎.Sort不管有没有，都会跳过它们SpecialCells(xlCellTypeVisible)- 有人可以证实这一点吗？

2. 这引出了我更普遍的问题：我不太清楚的一件事是 Excel/VBA 何时跳过筛选行，何时不跳过。要循环遍历可见单元格，我需要使用SpecialCells(xlCellTypeVisible). With .Sort我（也许）不知道？对于我在这些过滤列表上执行的任何操作，都会弹出这个问题。

这让我想知道：我应该使用隐藏部分数据的原始工作表，还是应该临时创建一个新工作表，仅复制我需要的数据（= 排除我用过滤器隐藏的行），然后工作接着就，随即？这张新的工作表会让它变得更快或更容易吗？根据您的经验，什么是更好的？

1. 当您尝试复制不相邻的单元格或范围选择时，例如同一列（A1、A3、A5）中的多个不相邻的行，就会出现第一个错误。这是因为 Excel 将范围“滑动”在一起并将它们粘贴为单个矩形。您的可见特殊单元格不相邻，因此无法作为单个范围进行复制。

2. 看起来 Excel 正在循环遍历范围内的所有单元格，而不仅仅是可见的单元格。您的 debug.print 返回的行数不仅仅是可见的行数。

我会采取不同的方法通过使用数组来解决您的问题，与工作表相比，VBA 能够非常快速地循环遍历。

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:我对数组进行了一些修改，使用以下命令将基于第一列从初始 190k 行复制 9k 行的时间缩短至 0.45 秒：

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

它不是超级干净，可能需要进行一些改进，但如果速度很重要（通常看起来很重要），那么这应该可以很好地满足您的要求。