Private Sub Worksheet_Change(ByVal Target As Range)
Dim Test As Range
Dim cl_Target As Range
Set Test = Intersect(Target, UsedRange)
If Test Is Nothing Then Exit Sub
For Each cl_Target In Test
Select Case cl_Target.Address(0, 0)
Case "L2:L300"
If cl_Target.Value = 4 Then Call w4bana
Case "L2:L300"
If cl_Target.Value = 5 Then Call w5bana
Oldvalue = Target
End Select
Next
End Sub
Доброе утро! Помогите, пожалуйста, реализовать вот такое (последовательная обработка тождественных событий столбца "L" лист1)? Эксель13, но можно любой вообще.
Нужно так, чтобы было коротко и быстро Даже можно без ожидания события, а просто вручную запускать макрос, если такой вариант самый быстрый! Или даже с использованием Calculate. В столбце L одновременно могут появиться до 10 одинаковых значений, и каждое должно быть обработано по одному алгоритму последовательно. Или не последовательно. Но только каждое.
Вижу, что нет решения... Как вариант можно написать алгоритм для каждого из 8 возможных значений каждой из 300 ячеек столбца, но это страшно громоздко. А если реализовать это через вот такую схему
Код
n=300
a = range("L2:L300")
for i = 1 to n
If Cells(a, 12) = 4 Then cells.activate and ActiveCell = "x" & ActiveCell and Application.Run "w4bana"
next i
[CODE][/CODE]То есть после того как нужная ячейка найдена, к ее значению "4" добавляется метка "х", запускается макрос, после чего происходит поиск следующего значения "4" и так до конца? А потом, когда все необходимые действия со столбцом L завершатся, можно легко "х" поудалять.
Thinglikeyou написал: просто вручную запускать макрос
суть такова:
Код
Sub posled()
ThisWorkbook.Sheets("Лист2").UsedRange.Clear
ThisWorkbook.Sheets("Лист3").UsedRange.Clear
With ThisWorkbook.Sheets("Лист1")
LastRow = .Cells(.Rows.Count, "L").End(xlUp).Row
For Each c In .Range("L2:L" & LastRow)
If c.Value = 4 Or c.Value = 5 Then
ii = c.Value
Set rn = .Range(c.Offset(0, -2), c.Offset(ii - 1, -1))
lr = ThisWorkbook.Sheets("Лист" & ii - 2).Cells(.Rows.Count, "A").End(xlUp).Row + 2
rn.Copy ThisWorkbook.Sheets("Лист" & ii - 2).Cells(lr, 1)
ii = 0
lr = 0
Set rn = Nothing
End If
Next
End With
End Sub
остальное отшлифуйте, пожалуйста, сами ... в конце можно просто добавить (перед End Sub)
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)