VBA: более быстрый способ сравнения двух диапазонов?

Question

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

Dim rng1 As Range
Dim rng2 As Range
Dim cell as Range
Dim found as Range

set rng1 = ....
set rng2 = ....
for each cell in rng1
set found = rng2.Find(what:=cell,.....
Next cell

Этот код в порядке, если диапазон в тысячах строк, один столбец.Когда дело доходит до десятков тысяч, это очень медленно.

В любом случае, чтобы ускорить его?

Answer 1

Это может быть самый быстрый способ для больших объемов данных:

Option Explicit
Sub Test()

    Dim rng1 As Range
    Set rng1 = YourShorterRange

    Dim rng2 As Range
    Set rng2 = YourLargerRange

    Dim C As Range
    Dim Matches As Object: Set Matches = CreateObject("Scripting.Dictionary")
    'input the larger data inside a dictionary
    For Each C In rng2
        If Not Matches.Exists(C.Value) Then Matches.Add C.Value, 1
    Next C

    Dim i As Long
    Dim arr As Variant
    'input the shorter data inside an array
    arr = rng1.Value
    For i = 1 To UBound(arr)
        If Matches.Exists(arr(i, 1)) Then
            'your code if the value is found
        End If
    Next i

End Sub

Правка для Дориана:

Option Explicit
Sub Test()

    Dim rng1 As Range
    Set rng1 = YourShorterRange

    Dim rng2 As Range
    Set rng2 = YourLargerRange

    Dim i As Long, j As Long
    Dim arr As Variant
    Dim Matches As Object: Set Matches = CreateObject("Scripting.Dictionary")
    arr = rng1.Value
    'input the larger data inside a dictionary
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            If Not Matches.Exists(arr(i, j)) Then Matches.Add arr(i, j), 1
        Next j
    Next i

    'input the shorter data inside an array
    arr = rng2.Value
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            If Matches.Exists(arr(i, j)) Then
                'your code if the value is found
            End If
        Next j
    Next i

End Sub

Answer 2

Может быть, что-то вроде этого:

Sub Test()

Dim arr1 As Variant, arr2 As Variant
Dim arrList As Object: Set arrList = CreateObject("System.Collections.ArrayList")
Dim x As Long

arr1 = rng1 'Specify your range
arr2 = rng2 'Specify your range

For x = LBound(arr2) To UBound(arr2)
    arrList.Add arr2(x, 1)
Next x

For x = LBound(arr1) To UBound(arr1)
    If arrList.contains(arr1(x, 1)) = True Then
        Debug.Print arr1(x, 1) & " contained within range 2"
    End If
Next x

End Sub

Answer 3

Я бы предложил вам:

Application.match

Вы также можете посмотреть здесь , вы найдете интересные исследования по 3 различным способам Поиск .Эти 3 различных способа будут изучены по времени и по количеству происшествий .

Согласно Fastexcel заключение этого исследования:

Не используйте Range.Find, если вы не хотите искать большое количество столбцов для одной и той же вещи (вам нужно будет выполнить сопоставление для каждого столбца).

Подход Variant array удивительно эффективен, особенно когда вы ожидаете большого количества попаданий.

Матч выигрывает легко для небольшого количества попаданий .

Так что если вы, кроме большого количества попаданий, вам, возможно, придется попробовать вариант массива метод.3 способа перечислены в Fastexcel tuto

Редактировать

Прочитав комментарий, я сделал новый тест:

Код варианта

Sub Test1()
Dim vArr As Variant
Dim j As Long
Dim n As Long
Dim dTime As Double
dTime = MicroTimer
vArr = Range("A1:B100000").Value2

Dim Matches As Object: Set Matches = CreateObject("Scripting.Dictionary")
arr = Range("G1:G15").Value
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            If Not Matches.Exists(arr(i, j)) Then Matches.Add arr(i, j), 1
        Next j
    Next i

For j = LBound(vArr) To UBound(vArr)
If Matches.Exists(vArr(j, 1)) Or Matches.Exists(vArr(j, 2)) Then n = n + 1
Next j
Debug.Print "Using Variant : " & n & " Timer :" & (MicroTimer - dTime) * 1000
End Sub

Словарь

Sub Test()


    Dim rng1 As Range
    Set rng1 = Range("A1:B100000")

    Dim rng2 As Range
    Set rng2 = Range("G1:G15")

    Dim i As Long, j As Long
    Dim arr As Variant

    Dim dTime As Double
    dTime = MicroTimer

    Dim Matches As Object: Set Matches = CreateObject("Scripting.Dictionary")
    arr = rng2.Value
    'input the larger data inside a dictionary
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            If Not Matches.Exists(arr(i, j)) Then Matches.Add arr(i, j), 1
        Next j
    Next i

    'input the shorter data inside an array
    arr = rng1.Value
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            If Matches.Exists(arr(i, j)) Then
                'your code if the value is found
                cpt = cpt + 1
            End If
        Next j
    Next i
Debug.Print "Using Damian Method : " & cpt & " Timer : " & (MicroTimer - dTime) * 1000
End Sub