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

avatar
Agent Smith
8 августа 2021 в 21:03
98
2
1

Итак, я пытаюсь выполнить задачу, в которой я извлеку значения из файла Excel. Внесите необходимые изменения в значения, а затем добавьте их в презентацию Powerpoint.

Следовательно, для достижения цели. Я использовал инструменты разработчика в Power Point и начал писать скрипт vba. Теперь цель получить значения из другого файла Excel и добавить их в PowerPoint стала более простой и понятной. ОДНАКО, когда я пытаюсь получить определенные значения из файла excel.

Например, значения, которые имеют значение "5" в столбце C (который будет иметь только число 1-5).

И я задавался вопросом/запутался, какой подход будет более быстрым/эффективным в этом случае.

Вариант A) Использовать автофильтр, чтобы отфильтровать список, а затем просмотреть все видимые ячейки? Вариант Б) Пройтись по всем столбцам, а затем получить значения?

Мне интересно, есть ли у автофильтра Excel какое-то преимущество перед обычным циклом For Each в Vba? А Следовательно будет быстрее?

ПРИМЕЧАНИЕ. Сценарий VBA будет запускаться из PowerPoint, поэтому для использования книги Excel и команд мне нужно создать объект «Excel.Application»

Редактировать: Исправление именования.

Источник
Qualia Communications
8 августа 2021 в 21:24
1

Я думаю, что было бы быстрее создать массив UsedRange в столбце C и проверить, совпадают ли записи. На StackOverflow вы найдете несколько вопросов и ответов, в которых подробно объясняется, как это сделать и почему это происходит быстрее.

VBasic2008
9 августа 2021 в 07:35
0

Не могли бы вы поделиться своим кодом? Мы хотели бы посмотреть, как вы открываете Excel, открываете книгу, создаете ссылки (устанавливаете) на лист и диапазон данных.

Agent Smith
9 августа 2021 в 15:59
0

Спасибо @Qualia, я посмотрю на это.

Ответы (2)

avatar
VBasic2008
9 августа 2021 в 10:09
1

Возврат значений диапазона 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
Agent Smith
9 августа 2021 в 16:13
0

Большое тебе спасибо. Это похоже на решение очень высокого уровня. Со многими вещами, о которых я, как новичок в VBA, знаю меньше. Таким образом, может потребоваться некоторое время, чтобы просочиться во всю информацию, которую вы предоставили.

avatar
Pᴇʜ
9 августа 2021 в 07:33
3

Если речь идет о скорости работы в 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 строк.

Agent Smith
9 августа 2021 в 16:07
0

Большое спасибо за информативный и подробный ответ. Что касается моей ситуации, отфильтрованные данные обычно будут <1000 строк. Следовательно, не могли бы вы предложить фильтровать, а затем просматривать ячейки для данных? Еще одно продолжение: будет ли просмотр этих 1000 строк и подсчет того, сколько раз повторяется каждое отдельное имя (в столбце A), будет быстрее, чем, скажем, создание сводной таблицы, а затем извлечение из нее значения? (Например, когда я создаю сводную таблицу, которая покажет мне количество различных имен для каждой категории (1-5). Это было практически мгновенно)