Используйте автофильтр или циклический просмотр файла в VBA Office 2013.

Возврат значений диапазона Excel в другом приложении Office

• Это решение с поздней привязкой (обратите внимание на множество объявлений As Object), то есть вы можете использовать его как есть, нет необходимости создавать ссылку на какую-либо библиотеку.
• Предполагается, что диапазон Excel начинается в ячейке A1, является непрерывным и имеет одну строку заголовков.
• Настройте значения в разделе констант второй процедуры (GetCriteriaRowsFromExcel), чтобы она работала на вас.

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Using the 'Print2D' procedure, prints the values
'               from the 2D one-based array
'               retrieved by the 'GetCriteriaRowsFromExcel' function
'               to the VBE Immediate window (Ctrl+G).
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub GetCriteriaTEST()
    
    ' Write the 'critical' rows to a 2D one-based array.
    Dim Data As Variant: Data = GetCriteriaRowsFromExcel
    If IsEmpty(Data) Then Exit Sub
    
    ' Print the array's values to the Immediate window ('Ctrl+G')
    Print2D Data, vbTab

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Opens a new instance of Excel, opens a workbook,
'               creates a reference to a worksheet and its current region range.
'               Then it creates a reference to the data range (without headers)
'               and by calling the 'GetCriteriaRows' function, returns
'               a 2D one-based array containing the 'critical' rows,
'               finally closing the instance of Excel.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetCriteriaRowsFromExcel() As Variant
    
    Const wbPath As String = "C:\Test\Test.xlsx"
    Const wsID As Variant = "Sheet1" ' or e.g. 1
    Const Criteria As Long = 5
    Const CritCol As Long = 3
    
    Dim xlApp As Object: Set xlApp = CreateObject("Excel.Application")
    'xlApp.Visible = False ' default is 'False'
    
    On Error GoTo ExcelError
    Dim wb As Object: Set wb = xlApp.Workbooks.Open(wbPath)
    Dim ws As Object: Set ws = wb.Worksheets(wsID)
    ' If the data is contiguous and starts in cell 'A1'.
    ' You may need something different here.
    Dim rg As Object: Set rg = ws.Range("A1").CurrentRegion
    Dim rCount As Long: rCount = rg.Rows.Count
    If rCount > 1 Then
        ' Create a reference to the data range (exclude the headers).
        Set rg = rg.Resize(rg.Rows.Count - 1).Offset(1)
        ' Write the 'critical' rows to a 2D one-based array.
        GetCriteriaRowsFromExcel = GetCriteriaRows(rg, Criteria, CritCol)
    End If
    wb.Close SaveChanges:=False

SafeExit:
    xlApp.DisplayAlerts = False
    xlApp.Quit
    
    Exit Function
    
ExcelError:
    Debug.Print Err.Description
    Resume SafeExit
    
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the values from an Excel range in a 2D one-based array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetCriteriaRows( _
    ByVal rg As Object, _
    ByVal Criteria As Variant, _
    Optional ByVal CriteriaColumn As Long = 1) _
As Variant
    
    If rg Is Nothing Then Exit Function
    If CriteriaColumn < 1 Then Exit Function ' out of bounds
    
    Dim srg As Object: Set srg = rg.Areas(1)
    Dim cCount As Long: cCount = srg.Columns.Count
    If CriteriaColumn > cCount Then Exit Function ' out of bounds
    
    Dim drCount As Long
    drCount = srg.Parent.Parent.Parent _
        .CountIf(srg.Columns(CriteriaColumn), Criteria)
    If drCount = 0 Then Exit Function ' no matches
    
    Dim srCount As Long: srCount = srg.Rows.Count
    If srCount + cCount = 2 Then Exit Function ' one cell only
    
    Dim sData As Variant: sData = srg.Value
    
    Dim dData As Variant: ReDim dData(1 To drCount, 1 To cCount)
    
    Dim sValue As Variant
    Dim sr As Long
    Dim c As Long
    Dim dr As Long
    For sr = 1 To srCount
        sValue = sData(sr, CriteriaColumn)
        If Not IsError(sValue) Then
            If sValue = Criteria Then
                dr = dr + 1
                For c = 1 To cCount
                    dData(dr, c) = sData(sr, c)
                Next c
            End If
        End If
    Next sr
    
    GetCriteriaRows = dData
        
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      One row at the time, prints the values of a 2D one-based array
'               to the VBE Immediate window (Ctrl+G).
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Print2D( _
        ByVal Data As Variant, _
        Optional ByVal Delimiter As String = ",")
    
    If IsEmpty(Data) Then Exit Sub
    
    On Error Resume Next
    Dim cLower As Long: cLower = LBound(Data, 2)
    If Err.Number <> 0 Then Exit Sub
    On Error GoTo 0
    Dim cUpper As Long: cUpper = UBound(Data, 2)
    Dim dLen As Long: dLen = Len(Delimiter)
    
    Dim r As Long
    Dim c As Long
    Dim rString As String
    For r = LBound(Data, 1) To UBound(Data, 1)
        rString = vbNullString
        For c = cLower To cUpper
            rString = rString & CStr(Data(r, c)) & Delimiter
        Next c
        Debug.Print Left(rString, Len(rString) - dLen)
    Next r

End Sub

Если речь идет о скорости работы в Excel, вам нужно подумать о следующих вещах:

• Каждое чтение/запись в ячейку сопряжено с высокими затратами на скорость. Уменьшение объема доступа для чтения/записи к вашим ячейкам сделает ваш код намного быстрее.
• Встроенные функции (обычно) быстрее, чем VBA. VBA не поддерживает многопоточность, в то время как встроенные функции могут.

Таким образом, если мы предположим, что 10000 ячеек и вы просматриваете их, это будет 10000 доступов для чтения к вашим ячейкам. Вы можете значительно уменьшить это, прочитав их все в массив и вместо этого зацикливаясь на массиве. Таким образом, у вас есть только 1 доступ для чтения вместо 10000.

Dim Data() As Variant
Data = Range("A1:A10000").Value  ' read data from range into an array (one read action only)

Dim iRow As Long
For iRow = LBound(Data, 1) To UBound(Data, 1)  ' loop through the array rows
    Debug.Print Data(iRow, 1)  ' process your data here
Next iRow

и если вам нужно записать данные обратно, это можно сделать с 1 доступом для записи также для всех данных

Range("A1").Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
' note that the range and the data need to be exact the same size!

Поэтому, быстрее ли фильтрация данных и цикл по отфильтрованным данным или цикл по массиву всех данных, в значительной степени зависит от самих данных, а также от правил фильтрации, которые вы хотите применить. Так что единственный способ узнать, какой из них быстрее, — попробовать и измерить время.

Например, если у вас есть 10 000 строк, а после фильтрации осталось только 3, фильтр может быть быстрее, чем цикл по массиву из 10 000 строк.