Функция VBA Instr на 100K + записей

Question

У меня есть 100.000 записей / строк с 17 столбцами. Необходимо проверить один из этих столбцов, чтобы вывести 1 или 0 в следующий столбец. Для этого я использую al oop с функцией Instr, но через 10 минут он все равно ничего не выводит на мою машину, и я считаю, что код слишком интенсивный или медленно запускает строку для строки.

Dim rng As Range
Set rng = Range("F:F")

For Each cell In rng
    TicketType = cell
    If InStr(1, TicketType, "locker", 1) > 0 Then
        cell.Offset(0, 1) = 1
    Else
        cell.Offset(0, 1) = 0
    End If
Next

Однако нужно проверить только 100 типов TicketTypes, и на основании названий этих типов TicketType следует вывести 1 или 0 (совпадать или нет). Поэтому я подумал: может быть, есть способ отсортировать всю таблицу, просмотреть ее, посмотреть, какие есть категории, сохранить их вертикальные диапазоны, выполнить проверку, а затем вывести + -10 000 строк одновременно? Я заметил, что это мгновенно, поэтому я считаю, что узким местом является именно функция Instr.

Answer 1

Попробуйте это:

Dim rng As Range, f
With ActiveSheet
    Set rng = Application.Intersect(.Columns("F"), .UsedRange)
    f = "=--NOT(ISERROR(SEARCH(""locker""," & rng(1).Address(False, False) & ")))"
    Debug.Print f
    rng.Offset(0, 1).Formula = f
    rng.Offset(0, 1).Value = rng.Offset(0, 1).Value
End With

Answer 2

вы можете попробовать фильтрацию:

With Worksheets("actualSheetName") '<-- change "actualSheetName" to your actual sheet name
    With .Range("F1", .Cells(.Rows.Count, "F").End(xlUp))
        .Offset(, 1).Value = 0
        .AutoFilter Field:=1, Criteria1:="*locker*"

        .SpecialCells(xlCellTypeVisible).Offset(, 1) = 1
    End With
    .AutoFilterMode = False
End With

Answer 3

Подход с использованием массива вариантов

Как упомянуто BigBen, это быстрее, чем проходить по каждой ячейке с помощью VBA.

Sub VariantArray()
With Sheet1

'~~> Set you relevant range here
    Dim lastRow As Long, rng As Range
    lastRow = .Range("F" & .Rows.Count).End(xlUp).Row
    Set rng = .Range("F1:F" & lastRow)

'~~> create a one based 2-dim datafield array
     Dim myArray As Variant
     myArray = rng

'~~> check TicketType
    Dim i As Long
    For i = 1 To UBound(myArray)
        myArray(i, 1) = IIf(InStr(1, myArray(i, 1), "locker", 1) > 0, 1, 0)
    Next i

    '~~> fill target with array values
    rng.Offset(0, 1) = myArray

End With
End Sub

Answer 4

Как предполагает BigBen, гораздо лучшим решением является использование функции рабочего листа, например Find.All() (по крайней мере, так, как я думаю, она называется). Если он что-то находит, он дает число, иначе он выдает ошибку. Вы можете превратить это в интересную формулу, подобную этой:

=IF(IF.ERR(FIND.ALL("locker";A2);0)=0;0;1)