Страницы: 1
RSS
Последовательная обработка тождественных событий
 
Код
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, но можно любой вообще.
Изменено: Thinglikeyou - 27.02.2017 10:36:17
 
так вам нужно срабатывании при событии или цикл по всему столбцу?
 
Нужно так, чтобы было коротко и быстро :) Даже можно без ожидания события, а просто вручную запускать макрос, если такой вариант самый быстрый! Или даже с использованием Calculate. В столбце L одновременно могут появиться до 10 одинаковых значений, и каждое должно быть обработано по одному алгоритму последовательно. Или не последовательно. Но только каждое.
Изменено: Thinglikeyou - 27.02.2017 13:44:34
 
Вижу, что нет решения... Как вариант можно написать алгоритм для каждого из 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)
Код
ThisWorkbook.Sheets("Лист2").Rows("1:2").Delete Shift:=xlUp
ThisWorkbook.Sheets("Лист3").Rows("1:2").Delete Shift:=xlUp
Изменено: JeyCi - 27.02.2017 20:56:03
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
Цитата
JeyCi написал:
суть такова:
JeyCi, большое спасибо, Ваше решение великолепно.  :)
А фишка Sheets("Лист" & ii - 2) вообще очень понравилась.
Изменено: Thinglikeyou - 27.02.2017 21:53:31
Страницы: 1
Наверх