Какой самый быстрый (в вычислительном отношении) способ поиска всех элементов, которые соответствуют набору критериев в электронной таблице, с использованием VBA?

Question

Большинство людей используют метод .Find объекта диапазона или используют такие функции, как If Not IsError(Application.Match([Value to Search in the Range],[Range to Search],0)), чтобы определить, можно ли найти определенное значение в диапазоне. Другие методы можно найти в здесь . Но если вы хотите соответствовать более чем одному критерию, все становится немного сложнее.

Например, я хочу проверить, присутствует ли определенная пара человек / дата в другом листе, а затем записать эту пару, если она не найдена в указанном листе. Ссылаясь на приведенный ниже пример.

Первый способ, о котором я бы подумал, - это использовать следующий код:

Option Explicit
Sub Payroll()

Dim i As Long, j As Long, Present As Long
Dim Total_rows_HoursWorked As Long
Dim Total_rows_DailyTimeRecord As Long

ThisWorkbook.Worksheets("Hours Worked").Cells(1, 1) = "Person"
ThisWorkbook.Worksheets("Hours Worked").Cells(1, 2) = "Date"

Total_rows_DailyTimeRecord = ThisWorkbook.Worksheets("Daily Time Record").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To Total_rows_DailyTimeRecord
    Present = 0
    Total_rows_HoursWorked = ThisWorkbook.Worksheets("Hours Worked").Range("A" & Rows.Count).End(xlUp).Row
    For j = 2 To Total_rows_HoursWorked
        If ThisWorkbook.Worksheets("Daily Time Record").Cells(i, 1) = ThisWorkbook.Worksheets("Hours Worked").Cells(j, 1) And _
        ThisWorkbook.Worksheets("Daily Time Record").Cells(i, 2) = ThisWorkbook.Worksheets("Hours Worked").Cells(j, 2) Then
            Present = 1
        End If
    Next j
    If Present = 0 Then
        ThisWorkbook.Worksheets("Hours Worked").Cells(Total_rows_HoursWorked + 1, 1) = ThisWorkbook.Worksheets("Daily Time Record").Cells(i, 1)
        ThisWorkbook.Worksheets("Hours Worked").Cells(Total_rows_HoursWorked + 1, 2) = ThisWorkbook.Worksheets("Daily Time Record").Cells(i, 2)
    End If
Next i

End Sub

результат будет ниже:

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

Я также могу использовать Arrays, чтобы ускорить процесс вместо циклического прохождения каждой строки на рабочем листе, но все равно придется go через большее количество строк, чем необходимо, чтобы найти совпадение.

Еще один метод, который можно использовать, - это .Autofilter, чтобы попытаться найти совпадения в определенном диапазоне, чтобы минимизировать зацикливание только для тех, которые соответствуют определенному критерии. Но есть и некоторое отставание в этом методе, но, как правило, он быстрее, чем в первом методе.

Как лучше или лучше выполнять такие задачи?

Редактировать: Это не просто поиск уникальные значения, но также похожие на поиск всех значений, которые соответствуют определенному набору критериев, как пример ниже:

Блог Чарльза Уильяма сделал это в способ, которым диапазоны изменяются для Application.Match и .Find, но показывает, что Variant Array работает лучше, но это означает, что единственный вариант - это создавать вложенные l oop и l oop через каждого по одному , но используя массив?

Answer 1

Это зависит от данных. Игнорируя возможности сортировки и использования бинарного поиска hi-lo, здесь в моем блоге есть сравнение использования массива FIND против MATCH против варианта для поиска по 2 столбцам.

https://fastexcel.wordpress.com/2011/10/26/match-vs-find-vs-variant-array-vba-performance-shootout/

Answer 2

Согласно моему комментарию, похоже, что вы просто интересуетесь всеми уникальными комбинациями имен и дат. Если это так, AdvancedFilter должен быть относительно быстрым:

Sub Payroll()

Dim ws1 as Worksheet: Set ws1 = ThisWorkbook.Worksheets("Daily Time Record")
Dim ws2 as Worksheet: Set ws2 = ThisWorkbook.Worksheets("Hours Worked")
Dim lr As Long: lr = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
Dim rng As Range: Set rng = ws1.Range("A1:B" & lr)

'Copy over unique values
rng.AdvancedFilter Action:=xlFilterCopy, copytorange:=ws2.Range("A1"), Unique:=True

End Sub