Прикладываю пример, прощу взгляните. И дайте какие то подсказки.. как можно ускорить процесс проверки 1 столбца на совпадение.
Дело в том что.. в 1 столбце вставляются фразы а в правом уже вставляется то, что нужно найти в 1.. и в правом столбце довольно много слов нужно прописывать.. и вот это дело тормозит неслыханно.. в примере около 500 слов.. это в среднем столько бывает.. но этому макросу сложно и 10 слов обработать.. тоже очень долго.
В левом столбце тоже объем довольно большим бывает.
Подскажите пожалуйста.. как можно доработать или переделать макрос... что бы обрабатывалось все это дело быстро.
Gagarin13, Что бросается в глаза, так это то, что если даже уже строка помечена (добавлена в массив rr) её все равно терзаете для других значений. Я б поменял циклы местами перебирая во внешнем цикле то что удаляем, при этом из второго цикла выходить при найденном совпадении.
Код
For li = 1 To lLastRow 'öèêë ñ ïåðâîé ñòðîêè äî êîíöà
For lr = 1 To UBound(avArr, 1)
If InStr(1, arr(li, 1), avArr(lr, 1), 1) > 0 Then
If rr Is Nothing Then
Set rr = Cells(li, 1)
Else
Set rr = Union(rr, Cells(li, 1))
End If
Exit For
End If
DoEvents
Next
DoEvents
Next
Я поменял циклы местами, как в вашем примере.. но у меня что то не сростается.. срабатывает инпатбокс а уже после нажатия ОК выбивает в ошибку.. что то я не так делаю, не могли бы чуть конкретнее дать пример как именно вы сделали замену в самом коде.. может я что то не правильно записал.
Цитата
Hugo написал: ...например там есть такое: букетбукетабукетахбукетикбукетовбукеты. Вот зачем искать 5 последующих, если уже искали первое?
Прошу прощения, просто накидал для примера не обработанный список, а так там всегда обычно по одному уникальному слову. Но в любом случае хоть там 10 уникальных ключей он в массиве первого столбца ищет веченость.
Ну, этот макрос в этих условиях вообще корректно работать не будет, ибо по поиску букет он найдет и букет, и букетик, которые искать нужно, и букетосик, который искать не нужно.
ну так и должно быть слова в примере не те, если нужно будет искать по точному совпадению то я уже смогу легко поменять.. Главный вопрос в том что он тупит неизмеримо
Не шибко выпендрежистый макрос на исходных данных работает 0,87с против 22с, выпендрежистый - 0,78с При увеличении диапазона в столбце А до 55500 строк 40с и 36с соответственно.
Код
Sub Color_SubStr_ССМ_2()
Dim sSubStr As String 'искомое слово или фраза
Dim lCol As Long 'номер столбца с просматриваемыми значениями
Dim lLastRow As Long, li As Long
Dim avArr, lr As Long
Dim arr, lInStr&
Dim t!
lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "Запрос параметра", 1))
If lCol = 0 Then Exit Sub
t = Timer
lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
'заносим в массив значения листа, в котором необходимо удалить строки
arr = Cells(1, lCol).Resize(lLastRow, 2).Value
'Получаем с ССМ значения, которые надо удалить в активном листе
With Sheets("ССМ") 'Имя листа с диапазоном значений на удаление
avArr = .Range(.Cells(2, 6), .Cells(.Rows.Count, 6).End(xlUp))
End With
'удаляем
For lr = 1 To UBound(avArr, 1)
sSubStr = avArr(lr, 1)
For li = 1 To lLastRow 'цикл с первой строки до конца
lInStr = InStr(1, arr(li, 1), sSubStr, 1)
If lInStr > 0 Then
If lInStr = 1 Then
If Mid$(arr(li, 1), lInStr + Len(sSubStr), 1) = " " Then arr(li, 2) = "x"
ElseIf lInStr - 1 + Len(sSubStr) = Len(arr(li, 1)) Then
If Mid$(arr(li, 1), lInStr - 1, 1) = " " Then arr(li, 2) = "x"
Else
If Mid$(arr(li, 1), lInStr - 1, 1) = " " And Mid$(arr(li, 1), lInStr + Len(sSubStr), 1) = " " Then arr(li, 2) = "x"
End If
End If
Next li
Next lr
Application.ScreenUpdating = 0
For li = 1 To lLastRow 'цикл с первой строки до конца
If Len(arr(li, 2)) Then Cells(li, 1).Interior.Color = 255
Next
Application.ScreenUpdating = 1
Debug.Print Format(Timer - t, "0.0000")
End Sub
RAN, Полагаю, что к исправленному алгоритму прибавилось еще исключением из обработки UNION. Как я писал тут результат уже подходит для работы, но ради интереса, а если массив слов второго массива в словарь, проверку разделить на слова и проверять по наличию в словаре? Хотя тогда точное совпадение получится.
БМВ написал: но ради интереса, а если массив слов второго массива в словарь, проверку разделить на слова и проверять по наличию в словаре? Хотя тогда точное совпадение получится.
я о таком тоже думал, но реализовать чуть геморойнее будет по моему)
RAN, Ваш пример работает супер. Пока буду тестировать.
RAN, БМВ, Спасибо большое за помощь и активное участие, очень благодарен. Буду пока пробовать все это внедрять и разбираться с этим))