Добрый день! Уважаемые знатоки, прошу помочь упростить работу макроса, так как выполнение его занимает длительное время (понимаю, что нужно вроде собрать в массив обработать и тд). Далее код будет срабатывать каждый раз при изменении ячеек в 5 столбце. Задача следующая, условие 1: Если в столбце 5, найдется ячейка со значением которая будет содержать текст *пример* (без учета регистра) то выполнить условие 2: проверка значения ячейки в последующей строке за 1ым выполненным условием, если не будет содержать текст *пример2* (без учета регистра), то в этой же ячейке вставить текст "Пример2 и что то ещё", далее в этой же строке в следующем столбце выполнить операцию: умножить на 100 значение ячейки выше на одну строку иначе: оставить всё как есть, проверять дальше диапазон проверки 1000 строк, будет наверно лучше даже, если выполнить проверку ячейки куда вносится изменение
Код
Sub example()
Dim i&
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 5).End(xlUp).Row
If Cells(i, 5).Value Like LCase("*пример*") Then
If Not Cells(i + 1, 5).Value Like LCase("*пример2*") Then
Cells(i + 1, 5) = "Пример2 и что-то ещё"
Cells(i + 1, 6) = Cells(i, 6).Value * 100
Else
End If
End If
Next
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Стандартные макросы нужно писать не в модуле листов (как у вас в файле), а в стандартных модуля (меню Insert - Module и там пишите свой макрос) Попробуйте так
Код
Sub example()
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 5).End(xlUp).Row
If LCase(Cells(i, 5).Value) Like "*пример*" Then
If Not LCase(Cells(i + 1, 5).Value) Like "*пример2*" Then
Cells(i + 1, 5) = "Пример2 и что-то ещё"
Cells(i + 1, 6) = Cells(i, 6).Value * 100
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Sub AddSameData()
Dim a, r, urg As Range
Set urg = ActiveSheet.UsedRange
Set urg = Intersect([E:F], urg.Resize(urg.Rows.Count + 1, urg.Columns.Count))
a = urg
For r = 1 To urg.Rows.Count - 1
If Not IsEmpty(a(r, 1)) Then
If LCase(a(r, 1)) Like "*пример*" Then
If Not LCase(a(r + 1, 1)) Like "*пример2*" Then
a(r + 1, 1) = "Пример2 и что-то ещё"
a(r + 1, 2) = Val(a(r, 2)) * 100
End If
r = r + 1
End If
End If
Next
urg.Cells(1).Resize(UBound(a), 2) = a
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
Ігор Гончаренко, прошу подсказать, а как производить проверку условий только в текущей и текущей+1 строках (где производится ввод данных), не затрагивая остальные?