Страницы: 1
RSS
VBA Вставить значения/текст и выполнить операцию, если выполняются условия
 
Добрый день!
Уважаемые знатоки, прошу помочь упростить работу макроса, так как выполнение его занимает длительное время (понимаю, что нужно вроде собрать в массив обработать и тд). Далее код будет срабатывать каждый раз при изменении ячеек в 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
Изменено: Morphеus - 13.02.2022 13:33:32
 
Стандартные макросы нужно писать не в модуле листов (как у вас в файле), а в стандартных модуля (меню 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
 
New, Спасибо за совет
В итоге после запуска получаю следующее


а хотелось бы следующее


Ещё макрос отрабатывает с задержкой, нельзя ли внести изменения, чтобы это происходило намного быстрее
 
будет описана задача, возможно, будет решение, а пока - решайте самостоятельно
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, задача описана
 
Цитата
написал:
операцию: умножить на 100 значение ячейки выше на одну строку
выше на одну строку относительно которой строки?

не можете обяснять словами - обьясните на примере
вот так было на старте, а вот так должно получиться после работы макроса
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, файл пример во вложении, до и после
 
Код
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 строках (где производится ввод данных), не затрагивая остальные?
Страницы: 1
Наверх