Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос не вставляет значение в следующую последнюю строку.
 
#1
04.03.2018 11:16:18
Доброе время суток уважаемые знатоки. Прошу помочь в решении такой задачи:
Если  диапазон А:А содержить значение из G1, и диапазон В:В содержить "да"
то этих совпадающих строк (но не всех) копировать в указанную ячейку.
Написал макрос. Но не понимаю почему он не даёт желаемый результат.
Всё нормально работает для 1-го цикла. Во 2-м цикле макрос опять копирует
в тот же ячейку как в 1-м цикле. Формулой могу это сделать. Но надо сделать макросом.
Файл прилагается. Спасибо.

Код
Sub copirovat_cells()
Dim lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row
lr2 = Cells(Rows.Count, 11).End(xlUp).Row + 1

    For i = 1 To lr
            If Cells(i, 1) = Cells(1, 7) And Cells(i, 2) = "да" Then
                    'cells(lr2,"K")=cells(i,1)
                Cells(i, 1).Copy Cells(lr2, "K")
                    Cells(i, 2).Copy Cells(lr2, "L")
                Cells(i, 3).Copy Cells(lr2, "M")
        Cells(i, 5).Copy Cells(lr2, "N")

            End If
        Next
End Sub
Изменено: abduvs77 - 04.03.2018 11:28:50
 
 
 
#2
04.03.2018 11:33:52
Здравствуйте. У вас lr2 не изменяется. Попробуйте записать так
Код
Sub copirovat_cells()
Dim lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row
'lr2 = Cells(Rows.Count, 11).End(xlUp).Row + 1

    For i = 1 To lr
            If Cells(i, 1) = Cells(1, 7) And Cells(i, 2) = "да" Then
            lr2 = Cells(Rows.Count, 11).End(xlUp).Row + 1
                    'cells(lr2,"K")=cells(i,1)
                Cells(i, 1).Copy Cells(lr2, "K")
                    Cells(i, 2).Copy Cells(lr2, "L")
                Cells(i, 3).Copy Cells(lr2, "M")
        Cells(i, 5).Copy Cells(lr2, "N")

            End If
        Next
End Sub

Или

Код
Sub copirovat_cells()
Dim lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lr
            If Cells(i, 1) = Cells(1, 7) And Cells(i, 2) = "да" Then
                'cells(lr2,"K")=cells(i,1)
                Cells(i, 1).Copy Cells(lr2, "K")
                    Cells(i, 2).Copy Cells(lr2, "L")
                Cells(i, 3).Copy Cells(lr2, "M")
               Cells(i, 5).Copy Cells(lr2, "N") 
               lr2=lr2+1 
            End If
        Next
End Sub

Изменено: gling - 04.03.2018 11:42:14
 
 
 
#3
04.03.2018 11:37:39
Цитата
abduvs77 написал:
Во 2-м цикле макрос опять копируетв тот же ячейку как в 1-м цикле.
Не нашёл в Вашем макрос второго цикла. Да и не нужен он. Проверьте:
Код
Sub copirovat_cells()
Dim lr As Long, i As Long, FreeRow As Long, sWord As String
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    sWord = Range("G1")
    FreeRow = 2
    Application.ScreenUpdating = False 'Отключили обновление экрана
    For i = 2 To lr
        If Cells(i, 1) = sWord Then
            If Cells(i, 2) = "да" Then
                Cells(FreeRow, 11) = sWord
                Cells(FreeRow, 12) = Cells(i, 3)
                Cells(FreeRow, 14) = Cells(i, 5)
                FreeRow = FreeRow + 1
            End If
        End If
    Next
    Application.ScreenUpdating = True 'Включили
End Sub
 
 
 
#4
04.03.2018 11:46:07
Спасибо уважаемый  gling, Вы точно указали на мою ошибку. lr2 не в правильном месте указал.
Ну а уважаемый Юрий М, как всегда с новыми решениями.
Спасибо Вам дорогие.
 
 
 
#5
04.03.2018 11:51:21
Оно совсем не новое - аналог Вашего. Только поменял имя переменной lr2 на FreeRow  ;)  
 
 
 
#6
04.03.2018 12:37:39
Юрий М,  я Вас считаю как моим учителем. Может сами незнаете, как многому научили меня в VBA.
Изменено: abduvs77 - 04.03.2018 12:49:23
 
 
 
#7
04.03.2018 12:39:25
gling,  я Вам по хорошему завидую. И в формулах и в VBA отлично разбираетесь.
 
 
 
#8
04.03.2018 12:45:39
gling,  может я не понимаю чего-то, но  lr2 не указано во втором коду который Вы предложили:

Код
Sub copirovat_cells()
Dim lr As Long
 
lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lr
            If Cells(i, 1) = Cells(1, 7) And Cells(i, 2) = "да" Then
                'cells(lr2,"K")=cells(i,1)
                Cells(i, 1).Copy Cells(lr2, "K")
                    Cells(i, 2).Copy Cells(lr2, "L")
                Cells(i, 3).Copy Cells(lr2, "M")
               Cells(i, 5).Copy Cells(lr2, "N") 
               lr2=lr2+1 
            End If
        Next
End Sub
Изменено: abduvs77 - 04.03.2018 12:47:11
 
 
 
#9
04.03.2018 12:58:06
Цитата
abduvs77 написал:
во втором коду который Вы предложили:
Я предложил только изменять переменную по мере работы цикла, а код копировал Ваш и вы сами в нем не объявили эту переменную. Юрий М, написал код как правильно должно быть, объявил все переменные и строки упорядочил. На такой код и смотреть приятно и читать понятно, видно разделение процедур. У Вас и у меня строки начинаются где захотят, это как то не красиво. Берите пример не с меня, а с Юрий М, В макросах я не специалист, умею, но не много.
 
 
 
#10
04.03.2018 13:02:58
gling,  понятно. Спасибо за уточнение.
 
 
 
Страницы: 1
Наверх