Страницы: 1
RSS
Остановить перебор ячеек при условии совпадения результата.
 
Друзья, доброй ночи.

Подскажите как решить проблему с перебором ячеек и остановкой макроса при совпадении с необходимыми условиями, голова деревянная не могу решить своим умом. Для примера сделать такой код и вложил файл, не судите строго на что хватило фантазии...
Код
Sub Макрос1()
'01.04.2019
If Range("B2") And Range("C2") > 0 Then 'выходим перебираем дальше
End If
If Range("B2") And Range("C2") = 0 Then 'выходим перебираем дальше
End If
If Range("B2") = 0 And Range("C2") > 0 Then MsgBox ("Не перенесены данные за 01.04.2019") 'выходим перебираем дальше
End If
Range("A2").Select 'выходим перебираем дальше
End If

'02.04.2019
If Range("B3") And Range("C3") > 0 Then 'выходим перебираем дальше
End If
If Range("B3") And Range("C3") = 0 Then 'выходим перебираем дальше
End If
If Range("B3") = 0 And Range("C3") > 0 Then MsgBox ("Не перенесены данные за 02.04.2019")
Range("A3").Select 'останавливаемся в A3
End If

'03.04.2019
If Range("B3") And Range("C3") > 0 Then
End If
If Range("B3") And Range("C3") = 0 Then
End If
If Range("B3") = 0 And Range("C3") > 0 Then MsgBox ("Не перенесены данные за 02.04.2019")
Range("A3").Select
End If

'и т.д. по датам...
End Sub

Фактически код не правильный это ясно, даёт ошибку Compile error: End If Withhout  Block If. Какими методами возможно решить проблему, возможно другими способами?
Спасибо.
 
Andrey Ka, код следует оформлять соответствующим тегом. Ищите такую кнопку (см. скрин) и исправьте своё сообщение.
По вопросу:
Цитата
Andrey Ka написал:
'выходим перебираем дальше
Так выходим или перебираем дальше? Это ведь разные вещи.
 
Код
Sub Macro1()
Dim i As Long
    For i = 2 To 31
        If Cells(i, 2) = 0 And Cells(i, 3) > 0 Then MsgBox "Не перенесены данные за " & Cells(i, 1)
    Next
End Sub
 
Если нужно с выходом из процедуры и выделением ячейки, то так:
Код
Sub Macro1()
Dim i As Long
    For i = 2 To 31
        If Cells(i, 2) = 0 And Cells(i, 3) > 0 Then
            MsgBox "Не перенесены данные за " & Cells(i, 1)
            Cells(i, 1).Select
            Exit Sub
        End If
    Next
End Sub

 
Юрий, ваш второй вариант решает мою проблему, то что нужно спасибо большое.
 
Юрий, добрый день. Возник еще один вопрос, как написать алгоритм кода при условии если:
Код
 If Cells(i, 2) > 0 And Cells(i, 3) > 0 Then

Остановится и выйти из процедуры.
Моя попытка в варианте ниже закончилась провалом, поскольку код начинает повтор цикла пока не дойдёт до последней ячейки...
Скрытый текст

Не могу понять как правильно написать, что бы результат поиска останавливался при первом совпадении условия >0 and >0 и выходил из процедуры, но так же корректно работал и по второму условию поиска.

Спасибо.
 
Код
 
Sub Macro1()
Dim i As Long
    For i = 2 To 31
        If Cells(i, 2) > 0 And Cells(i, 3) > 0 Then  Exit Sub
        If Cells(i, 2) = 0 And Cells(i, 3) > 0 Then
            MsgBox "Не перенесены данные за " & Cells(i, 1)
            Cells(i, 1).Select
            Exit Sub
        End If
    Next
End Sub
По вопросам из тем форума, личку не читаю.
 
а если так?
Код
If Cells(i, 2) > 0 And Cells(i, 3) > 0 Then Exit For
Вполне такой нормальный кинжальчик. Процентов на 100
 
В обоих случаях перестаёт работать второе условие, выполнение макроса завершается на первом и далее не выполняется....
Код
Dim i As Long    For i = 2 To 31
    
        If Cells(i, 2) > 0 And Cells(i, 3) > 0 Then MsgBox ("Нет данных для переноса.")
        Exit Sub
        
        If Cells(i, 2) = 0 And Cells(i, 3) > 0 Then
            MsgBox "Не перенесены данные за " & Cells(i, 1)
            Cells(i, 1).Select
            Exit Sub
        End If
    Next

При этом условии:
Код
If Cells(i, 2) > 0 And Cells(i, 3) > 0 Then Exit For
Так же макрос не работает по второму.
Изменено: Andrey Ka - 12.04.2019 10:47:03
 
Цитата
Andrey Ka написал: В обоих случаях перестаёт работать второе условие
А вы что хотели?
Цитата
Andrey Ka написал: Остановится и выйти из процедуры.
По вопросам из тем форума, личку не читаю.
 
Цитата
Andrey Ka Не могу понять как правильно написать, что бы результат поиска останавливался при первом совпадении условия >0 and >0 и выходил из процедуры, но так же корректно работал и по второму условию поиска.
Возможно не корректно написал, но смысл во всём остальном коде если он не работает полностью...  :sceptic:  

условия > 0 and > 0 и выходил из процедуры, а так же корректная работа кода при условии, если = 0 and > 0  то msgbox ... друг за другом.
Изменено: Andrey Ka - 12.04.2019 14:46:17
 
Цитата
Andrey Ka написал:
смысл во всём остальном коде если он не работает полностью
Не смог переварить ))
Переформулируйте задачу применительно к прикреплённому файлу: что, где, когда.
 
Юрий, друзья на данный момент проблема решилась, переделал другой макрос который вызывает этот. Вопрос решился спасибо за помощь!
 
Всем доброе утро, друзья я слишком рано обрадовался, у меня оказывается ничего не вышло, а я то думал... В общем я за очередной добавкой помощи!
Юрий и коллеги по "заводу", на всякий случай попробую без воды задать ещё раз тот же вопрос.
Как в текущий код добавить следующую команду:
Код
Sub Macro1()Dim i As Long
    For i = 2 To 31
        If Cells(i, 2) = 0 And Cells(i, 3) > 0 Then
            MsgBox "Не перенесены данные за " & Cells(i, 1)
            Cells(i, 1).Select

'Если Cells(i, 2) > 0 And Cells(i, 3) > 0 Then Последняя заполненная ячейка за которую переносили 
'данные т.е. 03.04.2019 исходя из вложенного примера
'поскольку Cells(i, 2) и Cells(i, 3) > 0

End If

            Exit Sub
        End If
    Next
End Sub

И по скольку 04.04.2019

Код
Cells(i, 2) = 0 And Cells(i, 3) = 0
остановка макроса и MsgBox "Данные для переноса отсутствуют " & Cells(i, 1)
Как то так...
Спасибо.

Изменено: Andrey Ka - 15.04.2019 06:23:18
 
Добрый день!

М.б. Вы это хотели получить...
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
Страницы: 1
Наверх