Моя функция соответствия занимает слишком много времени (3 часа !!), нужна еще одна рекомендация

Я не уверен, что вы достаточно хорошо понимаете точку зрения СкоттаКрейнера. Он говорит, что вы должны прочитать все свои ссылочные значения (то есть большой список ценных бумаг) в пару массивов, и вы должны записать свои выходные значения в другой массив. Затем вы записали бы весь выходной массив на лист одной командой.

Может также стоить преобразовать ваш список ценных бумаг в Collection, поскольку у него очень быстрая возможность поиска. Были бы способы сделать это намного быстрее, например, путем сортировки ценных бумаг, но для этого вам понадобится немного математики.

В приведенном ниже примере этот скелетный код показывает, как это можно сделать. Вы должны знать, что я не удосужился разделить два списка ценных бумаг на две коллекции, поэтому вы захотите сделать это самостоятельно, если вам это нужно. Я также поместил все свои тестовые таблицы в одну и ту же рабочую книгу, поэтому при необходимости измените квалификаторы рабочих листов:

Option Explicit

Sub RunMe()
    Dim securities As Collection
    Dim testSheet As Worksheet
    Dim testItems As Variant
    Dim i As Long
    Dim exists As Boolean
    Dim output() As Variant

    'Read the first list of securities into the collection.
    PopulateColumnCollection _
        ThisWorkbook.Worksheets("First Sheet"), _
        "B", _
        securities

    'Read the second list of securities into the collection.
    'I've used the same collection in this example, you'll need
    'to create two if you want separate columns in your output.
    PopulateColumnCollection _
        ThisWorkbook.Worksheets("Second Sheet"), _
        "B", _
        securities

    'Read the test items into an array.
    Set testSheet = ThisWorkbook.Worksheets("in1")
    With testSheet
        testItems = RangeTo2DArray(.Range( _
            .Cells(2, "O"), _
            .Cells(.Rows.Count, "O").End(xlUp)))
    End With

    'Prepare your output array.
    'I've just used one column for output. If you want two then
    'you'll need to resize the second dimension.
    ReDim output(1 To UBound(testItems, 1), 1 To 1)

    'Populate the output array based on the presence of
    'a matching security.
    For i = 1 To UBound(testItems, 1)
        If IsEmpty(testItems(i, 1)) Then
            output(i, 1) = "No Security"
        Else
            exists = False: On Error Resume Next
            exists = securities(CStr(testItems(i, 1))): On Error GoTo 0
            output(i, 1) = IIf(exists, "US", "Not a US Security")
        End If
    Next

    'Write the output array to your sheet.
    testSheet.Cells(2, "P").Resize(UBound(output, 1), UBound(output, 2)).Value = output
End Sub

Private Function RangeTo2DArray(rng As Range) As Variant
'Helper function to read range values into an array.

    Dim v As Variant
    Dim arr(1 To 1, 1 To 1) As Variant

    v = rng.Value2
    If Not IsArray(v) Then
        arr(1, 1) = v
        RangeTo2DArray = arr
    Else
        RangeTo2DArray = v
    End If
End Function
Private Sub PopulateColumnCollection(ws As Worksheet, columnIndex As String, col As Collection)
'Helper sub to read a column of values into a collection.
    Dim rng As Range
    Dim v As Variant
    Dim i As Long

    With ws
        Set rng = .Range( _
            .Cells(1, columnIndex), _
            .Cells(.Rows.Count, columnIndex).End(xlUp))
    End With
    v = RangeTo2DArray(rng)

    If col Is Nothing Then Set col = New Collection

    On Error Resume Next 'this avoids duplicates.
    For i = 1 To UBound(v, 1)
        col.Add True, CStr(v(i, 1))
    Next

End Sub