Есть ли более быстрый способ выполнить эту функцию цикла instr?
У меня большой набор данных (т.е. более 100 000 строк). Мне нужно перебрать значения в одном или нескольких столбцах, и если условия instr равны ИСТИННЫЙ, я обновлю значение другого столбца до 1. Однако первая функция цикла, которую я написал, выполняется слишком долго (я принудительно вышел через пять минут) . Есть ли способ написать эту функцию, которая будет выполняться быстрее?
Я пытался использовать несколько if/then вместо одного if/then, но это не сработало.
Sub bucketup()
Dim SrchRng As Range, cel As Range
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Set SrchRng = Range("Data!D4:D" & LastRow)
For Each cel In SrchRng
'''''' Check 1 ''''''
'Check 1 Sub 1'
If cel.Offset(0, 12).Value = "North" AND (InStr(1, UCase(cel.Value), "SUBSTRING®") > 0 Or InStr(1, UCase(cel.Value), "SUBSTRING®") > 0 Or InStr(1, UCase(cel.Value), "SUBSTRING®") > 0) Then
cel.Offset(0, 15).Value = 1
End If
Next cel
End Sub
Ожидаемый результат состоял в том, что для каждой строки where column P = "North" и столбца D, содержащих одну из подстрок, столбец S будет установлен в 1. Фактический результат — неопределенно длинный запрос, время выполнения которого делает его непригодным для использования.
Ответы 2
Попробуйте работать с массивом, загруженным из рабочего листа, вместо того, чтобы перебирать ячейки рабочего листа.
Вы также должны «закоротить» свои критерии выбора. Ваше основное сравнение заключается в том, является ли столбец P север. Я думаю, разумно предположить, что возможности равны 1 из 4 (N из N, S, E, W) или 1 из 8 (N из N, NE, NW, S, SE, SW, E, W). Если вы поместите все критерии выбора в один и тот же оператор If, вы будете искать SUBSTRINGx гораздо больше раз, чем нужно. Вынесите проверку север на отдельный оператор If и продолжите проверку, только если найдено совпадение.
Option Explicit
Sub bucketup()
Dim SrchRng As Range, cel As Range
Dim searchArr As Variant, resultArr As Variant
Dim i As Long
With Worksheets(ActiveSheet.Name)
searchArr = .Range(.Cells(4, "D"), .Cells(.Rows.Count, "D").End(xlUp).Offset(0, 12)).Value2
ReDim resultArr(LBound(searchArr, 1) To UBound(searchArr, 1), 1 To 1)
For i = LBound(searchArr, 1) To UBound(searchArr, 1)
If searchArr(i, 13) = "North" Then
If InStr(1, searchArr(i, 1), "SUBSTRING®", vbTextCompare) > 0 Or _
InStr(1, searchArr(i, 1), "SUBSTRING®", vbTextCompare) > 0 Or _
InStr(1, searchArr(i, 1), "SUBSTRING®", vbTextCompare) > 0 Then
resultArr(i, 1) = 1
End If
End If
Next i
.Cells(4, "S").Resize(UBound(resultArr, 1), UBound(resultArr, 2)) = resultArr
End With
End Sub
Спасибо, @user11314630. Я думаю, что обновление столбца S должно быть .Cells(4, "S").Resize(UBound(resultArr, 1), UBound(resultArr, 2)) = resultArr. Вопрос: учитывая, что мой массив результатов будет многомерным, как заполнить дополнительные столбцы (например, столбец T, U, V)?
Спасибо. Я поменял вещи на полпути и, видимо, пропустил это изменение. Если они будут рядом с S, сделайте второй ранг resultArr от 1 до 4.
Вы также можете попробовать этот подход, чтобы посмотреть, какой из них лучше всего подходит для вас.
Option Explicit
Sub Find_Cell_Value()
Dim c As Range
Dim firstaddress As String
Dim Lastrow As Long
Dim Look as Worksheet
Set Look = ActiveSheet
Lastrow = Look.Cells(Rows.Count, "P").End(xlUp).Row
With Look.Range("P2:P" & Lastrow)
Set c = .Find("North", LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
If InStr(Look.Cells(c.Row, "D"), "SUBSTRING®") > 0 _
Or InStr(Look.Cells(c.Row, "D"), "SUBSTRING®") > 0 _
Or InStr(Look.Cells(c.Row, "D"), "SUBSTRING®") > 0 Then
Look.Cells(c.Row, "C") = 1
End If
Set c = .FindNext(c)
If c Is Nothing Then
GoTo DoneFinding
End If
Loop While c.Address <> firstaddress
End If
DoneFinding:
End With
End Sub
Если данных не слишком много, я буду использовать
.Find, чтобы сначала найти ПОДСТРОКА, учитывая, что это часть 3 условий соответствия, а затем выполнить остальные сравнения. Если данных слишком много, я копирую данные в массив, затем ищу ПОДСТРОКА, а затем выполняю остальные сравнения. Попытка выполнить все условия одновременно замедлит цикл.