Блог

Как следует из названия, функция сопоставления занимает слишком много времени. Одна электронная таблица имеет длину 100 000 строк, и в ней есть куча ценных бумаг, которые мне нужно убедиться, что они находятся в другой электронной таблице, в которой 800 000 строк. Ниже приведен код:

К вашему сведению, я средний специалист по созданию кода, поэтому я довольно примитивен в плане изложения своих аргументов.

  Option Explicit
 'a lot of dims
 StartTime = Timer

 Set ShVar = ThisWorkbook.Worksheets("in1")


With wnewwqr
    Set OutShVar = wnewwqr.Worksheets("First Sheet")
    Set RngConcat = OutShVar.Range("B:B")
    Set RngConcatISIN = OutShVar.Range("A:A")
    Set OutShVar1 = wnewwqr.Worksheets("Second Sheet")
    Set RngConcat1 = OutShVar1.Range("B:B")
    Set RngConcatISIN1 = OutShVar1.Range("A:A")
End With

With ShVar
    lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row
 End With

 For i = 2 To lastrow
     With ShVar

         If .Range("O" amp; i).Value = "" Then     
             .Range("P" amp; i amp; ":Q" amp; i).Value = "No Security"   'Checking for no securities
         Else
             If Not IsError(Application.Match(.Range("O" amp; i).Value, RngConcat, 0)) Then
                 .Range("P" amp; i).Value = "US"     ' writing US when it finds a US security in the confidential workbook
             Else
                 .Range("P" amp; i).Value = "Not a US Security"
             End If
         End If
         If .Range("P" amp; i).Value = "Not a US Security" Then
             If Not IsError(Application.Match(.Range("O" amp; i).Value, RngConcat1, 0)) Then        'Only searching for securities if the first vlookup resulted in nothing and then it would go into the second sheet
                 .Range("Q" amp; i).Value = "US"
             Else
                 .Range("Q" amp; i).Value = .Range("P" amp; i).Value
             End If
         End If
     End With
 Next i



SecondsElapsed = Round(Timer - StartTime, 2)
'Notify user in seconds
MsgBox "This code ran successfully in " amp; SecondsElapsed amp; " seconds", vbInformation
End Sub
  

Обновить:

Я перевел все в variant и теперь использую функцию find, но все еще не так быстро, как я надеялся. Заняло 14 минут ок. выполнить пробный запуск 2000 строк. И я должен сделать это для 90 000 строк

 Option Explicit
Sub something
Dim lastrow As Long
Dim OutShVar As Worksheet
Dim ShVar As Worksheet
Dim WhatCell As Range
Dim i As Long
Dim TaskID As Variant
Dim confidentialfp As String
Dim confidential As String
Dim wconfidential As Workbook
Dim x As Variant

Set ShVar = ThisWorkbook.Worksheets("in1")

With ShVar
lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row
End With

 confidential = "confidential_2018-03-01 (Consolidated).xlsx"


Set wconfidential = Workbooks(confidential)

With wconfidential
Set OutShVar = .Worksheets("First Sheet")
End With

 With ShVar
 For i = 1 To lastrow
 TaskID = ShVar.Range("O" amp; i).Value
Set x = .Range("A" amp; i)
 Set WhatCell = OutShVar.Range("B:B").Find(TaskID, lookat:=xlWhole)
On Error Resume Next
x.Offset(0, 7).Value = WhatCell.Offset(0, 1)
Next i
End With

End Sub
  

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

Возможно, также стоит преобразовать ваш список ценных бумаг в 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