VBA：處理過濾的行和SpecialCells（xlCellTypeVisible）與將數據復制到新表中

Question

我有一個包含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)時才會發生，因此wsData.Range(wsData.Cells(1, 1), wsData.Cells(lRowData, lColData)).Sort Key1:=wsData.Range("B1:B100"), Order1:=xlDescending, Header:=xlYes有效的。

我在使用SpecialCells(xlCellTypeVisible)時的想法是，只有VBA才會跳過過濾的單元格。 我嘗試了一下，但對我來說。無論是否有SpecialCells(xlCellTypeVisible) ， .Sort跳過它們-有人可以確認嗎？

2. 這就引出了我的一個更籠統的問題：我不清楚的一件事是Excel / VBA何時跳過過濾的行，何時不跳過。 要遍歷可見的單元格，我需要使用SpecialCells(xlCellTypeVisible) 。 使用.Sort我（也許）不？ 對於我將在這些過濾列表上執行的任何操作，此問題始終會彈出。

這讓我感到疑惑：我應該使用隱藏了部分數據的原始工作表還是應該臨時創建一個新工作表，只復制所需的數據（=排除使用過濾器隱藏的行），然后工作接着就，隨即？ 這張新紙可以使它更快或更容易嗎？ 您的經驗中有什么更好的？

Answer 1

1. 當您嘗試復制不相鄰的單元格或范圍選擇（例如，同一列（A1，A3，A5）中的多個不相鄰的行）時，會發生第一個錯誤。 這是因為Excel將范圍“滑動”在一起並將其粘貼為單個矩形。 您可見的特殊單元格不相鄰，因此不能復制為單個范圍。

2. 似乎excel正在遍歷您范圍內的所有單元，而不僅僅是可見的單元。 您的debug.print返回的行比可見行還要多。

我將采用另一種方法來解決問題，即使用數組，與工作表相比，VBA能夠非常快速地遍歷數組。

使用這種方法，我能夠在4.55秒鍾內從190k的樣本大小基於第一列的值復制9k行和10列：

編輯：我做了一些弄亂的數組，使用以下命令將時間縮短至0.45秒，以便根據第一列從最初的190k復制9k行：

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注釋，您正在復制不相鄰的單元格。 同樣，使用排序將改變您的基礎數據，如果您需要確定將來如何對它們進行初步訂購，這可能會產生影響。

使用過濾器可能會變得非常復雜，因此一種更簡單（但並非特別慢）的方法可能是使用所選列中的過濾值進行字符串搜索，然后循環返回對每個結果執行操作的實例。

大衛·澤門斯（David Zemens）的以下（略有改編）代碼將是一個很好的起點（從“ 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