Просьба помочь с этим кодом. Принцип работы: Берет значения из столбца С (у меня макрос реагирует тут на изменение в ячейке, т.к каждый раз добавляется новое слово и его нужно найти) и ищет их в столбце B, далее помечает найденные ячейки желтым. Все работает как надо, только есть одно НО. При большом кол-ве текста и при добавлении искомых слов (они регулярно добавляются) И чем больше искомых слов то тем дольше он думает. Я так понял, он каждый раз заново все искомые слова обрабатывает и ищет в тексте, хотя он уже их находил и уже пометил цветом, и вот нужно объяснить ему что бы он эти слова больше не искал если он их уже нашел и пометил один раз. Получается ему нужно реагировать на каждое искомое слово только один раз и больше не искать его. Заранее большое спасибо кто сможет помочь!
Sanja, пример поправил. Если разбираться не интересно, то какой интерес тогда писать сюда. Можно отвечать хотя бы как минимум по уважительнее, без такого высокомерия. Тем более то что забыл прописать "Лист1" (что очень трудно) по моему не повод для такого обращения.
Где Вы неуважительное отношение к себе увидели? И высокомерие? Я вот думаю наоборот. Человек просящий помощи, но наплевательски относящийся к составлению файла-примера более неуважителен к желающим помочь Да и файл-пример ничуть не изменился, все так же вылетает с ошибками
Sanja написал: но наплевательски относящийся к составлению файла-примера более неуважителен к желающим помочь
где интересно видно наплевательски, а фактор того что человек мог ошибочно выслать не тот файл и просто забыть сменить название листа в примере?
Цитата
Sanja написал: Да и файл-пример ничуть не изменился, все так же вылетает с ошибками
Я еще не успел заменить, пришлось отойти после отписания коммента о замене. Сейчас уже заменил.
Цитата
Sanja написал: Где Вы неуважительное отношение к себе увидели? И высокомерие?
ну как минимум так выглядит, потому что сами же описываете что там название листа не то и дальше смотреть из за этого не интересно. Я не хочу никого оскорбить, но просто так выглядит Ваше предыдущее сообщение.
За то что файл не тот поставил прошу прощения конечно. Заменил
Fsociety_, Вы не проверили файл перед отправкой на форум, что действительно является неуважением к потенциальными помощникам: неизвестно, сколько человек зря скачали Ваш файл. Косяк Ваш, а Вы обвиняете в неуважении того, кто собирался Вам помочь и вынужден был обратить внимание на ошибку. Я бы поступил аналогично. И желание продолжать у меня тоже пропало бы. Где здесь высокомерие и неуважительность?
Если привязываться к раскраске ячейки, то ускорить работу макроса не получится. Нужен какой-то другой признак, который можно одним махом, с исходными предложениями, взять в массив. Это могут быть какие нибудь 'х' справа/слева от уже проверенных данных
Согласие есть продукт при полном непротивлении сторон
Sanja, Это из за раскраски так тормозит? Я думал из за того что он каждый раз заново слова ищет и помечает каждый раз при добавлении новой фразы. Вы предложили вставлять символ напротив найденной ячейки, а так не получится сделать с цветами? Что бы он один раз пометил те слова которые найдет и в следующие разы слова которые он уже искал больше не искал. Просто есть пару нюансов. 1. У меня в файле нету свободных столбцов вплоть до столбца "H" только там уже можно будет символы ставить. 2 нюанс в том, что у меня еще другие макросы которые взаимодействуют как раз с этими помеченными желтыми ячейками. Если действовать по вашему предложению то мне придется все коды перелопачивать.
Из за раскраски ячеек теряются все преимущества использования массива Вот в этой строке Вы забираете все исходные значения в массив, для дальнейшей работы с ними в памяти, без обращения к ячейкам листа, что само по себе верно
Код
Arr = Cells(1, lCol).Resize(lLastRow, 2).Value
а далее, при заливки ячеек желтым, Вы все равно проходите все исходные данные поячеечно, что обнуляет преимущество массива.
Код
For li = 5 To lLastRow
If Arr(li, 2) = "x" Then Cells(li, 2).Interior.Color = 65535
Next
Можно было тогда вообще с массивом не заморачиваться, сразу писать что то типа такого
Код
For li = 5 To lLastRow
For lr = 1 To UBound(avArr, 1)
If Cells(li, 2) Like "* " & LCase(avArr(lr, 1)) & "*" Then Cells(li, 2).Interior.Color = 65535
Next
Next
Согласие есть продукт при полном непротивлении сторон
Вариант. Преимущество в скорости повторной обработки будет только в рамках одного сеанса. После закрытия книги переменная arr() обнулится.
Скрытый текст
Код
Public arr()
Sub Del_Array_SubStr()
Dim avArr(), I&, J&
Dim clYellow As Range
Dim t As Date
t = Timer
With Worksheets("Лист1")
If IsArrayEmpty(arr) Then
arr = .Range("B5:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).Value
ReDim Preserve arr(1 To UBound(arr), 1 To 2)
End If
avArr = .Range("C5:C" & .Cells(.Rows.Count, "C").End(xlUp).Row).Value
For I = 1 To UBound(arr)
For J = 1 To UBound(avArr)
If arr(I, 2) <> "x" Then
If arr(I, 1) Like "* " & LCase(avArr(J, 1)) & "*" Then
arr(I, 2) = "x"
If Not clYellow Is Nothing Then
Set clYellow = Union(clYellow, .Cells(I + 4, 2))
Else
Set clYellow = .Cells(I + 4, 2)
End If
End If
End If
Next
Next
If Not clYellow Is Nothing Then clYellow.Interior.Color = 65535
End With
MsgBox Format((Timer - t) * 1000, "0.000")
End Sub
Private Function IsArrayEmpty(x) As Boolean
Dim I&
On Error Resume Next
I = LBound(x)
IsArrayEmpty = Err <> 0
End Function
Цитата
Fsociety_ написал: другие макросы которые взаимодействуют как раз с этими помеченными желтыми ячейками
А вообще, привязываться к цвету ячейки, как к какому то признаку, плохая идея
Fsociety_ написал: У меня в файле нету свободных столбцов вплоть до столбца "H" только там уже можно будет символы ставить.
Ну и используйте его для признака. Скройте столбец H, и никто разницы не заметит
Код
Sub Del_Array_SubStr()
Dim arr(), avArr(), I&, J&
Dim clYellow As Range
Dim t As Date
t = Timer
With Worksheets("Лист1")
arr = .Range("B5:H" & .Cells(.Rows.Count, "B").End(xlUp).Row).Value
avArr = .Range("C5:C" & .Cells(.Rows.Count, "C").End(xlUp).Row).Value
For I = 1 To UBound(arr)
For J = 1 To UBound(avArr)
If arr(I, 7) <> "x" Then
If arr(I, 1) Like "* " & LCase(avArr(J, 1)) & "*" Then
arr(I, 7) = "x"
If Not clYellow Is Nothing Then
Set clYellow = Union(clYellow, .Cells(I + 4, 2))
Else
Set clYellow = .Cells(I + 4, 2)
End If
End If
End If
Next
Next
If Not clYellow Is Nothing Then clYellow.Interior.Color = 65535
.Range("H5").Resize(UBound(arr), 1) = Application.Index(arr, 0, 7)
End With
MsgBox Format((Timer - t) * 1000, "0.000")
End Sub
Sanja написал: Ну и используйте его для признака. Скройте столбец H, и никто разницы не заметит
Ну я бы и с радостью, но как я ранее писал, проблема будет в том что придется остальные макросы переделывать под работу этого. Т.к те макросы тоже завязаны на цвете. Ладно, я сегодня попробую что то с этим сделать вечером, отпишусь. Пока код не пробовал, но заранее благодарю за проделанную работу. Вечером протестирую отпишу)
Да простите, небыло времени, ответил, что бы не подумали что кинули тему) Я посмотрел все прямо отлично. Сразу спасибо, за то что сохранили основную структуру кода, это было важно. Есть только одно но, К примеру если в текстом в котором мы ищем слова будет одно слово, то он его не найдет, изначально макрос находил такие слова.
И еще такой вопрос: Тут получается если в столбце с искомыми словами "C" будет меньше двух заполненных ячеек, то будет ошибка вылазить, как это можно исправить, что бы он искал и одно слово тоже?
P.S прошу прощения что долго не отвечал, вчера вообще небыло возможности