Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Копирование данных с листа по условию
 
#1
16.10.2019 15:52:13
Добрый день!
Подскажите как реализовать копирование данных с одного листа на другой по условию!
А именно:
Имеем лист "маршруты" где постоянно обновляются данные, их необходимо скопировать на лист "DATA000" в соответствующие столбцы (идентичные по названию).
На листе "DATA000" в других столбцах формулы, необходимо чтобы копировались/обновлялись данные только в тех столбиках где нет формул.
Условие копирования на листе "маршруты" в колонке R, если написано там "zag" то эти данные пропускать
 
 
 
#2
16.10.2019 16:00:56
Денис Ш., т.е просто скопировать без какой либо логики?? или все таки ?

вот этот вариант вам думаю подойдет не копирование конечно...
https://www.planetaexcel.ru/techniques/2/81/
Изменено: Mershik - 16.10.2019 16:04:41
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
16.10.2019 16:05:27
Mershik да, просто перенос(копирование) данных. Я раньше использовал просто формулу =Ячейка но когда потребовалось выбирать по условию уже так не получается. В данный момент копаю в сторону макроса.

Боюсь, ВПР обрушит мне базу данных, она уже весит 45 мб
Изменено: Денис Ш. - 16.10.2019 16:06:24
 
 
 
#4
17.10.2019 10:43:38
Подскажите, что я делаю не так? Перед заполнением я хочу чтобы конкретный столбец очищался, но этого не происходит. И не посредственно это со столбцом D в A все работает
Код
Sub COPY()
Dim iLastRow As Long, i As Long, LastRow As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("DATA000") 
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        Range(.Cells(2, "D"), .Cells(LastRow + 1, "D")).ClearContents
        LastRow = 1
        For i = 2 To iLastRow
                If InStr(1, Cells(i, "O"), "zag", vbTextCompare) <> 0 Then 'If Len(Cells(i, 3)) = 6 Then
                    Cells(i, "H").COPY .Cells(LastRow + 1, "D")
                    'Range(Cells(i, 8), Cells(i, 8)).Copy .Cells(LastRow + 1, 1)
                    LastRow = LastRow + 1
                End If
        Next
    End With
End Sub
Изменено: Денис Ш. - 17.10.2019 10:45:24
 
 
 
#5
17.10.2019 10:46:59
Вопрос не по теме.
 
 
 
#6
17.10.2019 10:47:47
Почему? Это все с тем же документом и с той же задачей
 
 
 
#7
17.10.2019 10:48:07
При запуске макроса находитесь на листе "DATA000"?
Если нет, то нужна точка тут .Range.
Изменено: МатросНаЗебре - 17.10.2019 10:50:28
 
 
 
#8
17.10.2019 10:51:33
Нет, нахожусь на листе "маршруты". Вызов макроса сделал с кнопки на листе "маршруты"
 
 
 
#9
17.10.2019 10:52:26
Копирование, очистка даннх...
Цитата
Денис Ш. написал: Это все с тем же документом и с той же задачей
Это у Вас вопросы в одной задаче. Не у всех так
 
 
 
#10
17.10.2019 11:00:04
Цитата
МатросНаЗебре написал:
При запуске макроса находитесь на листе "DATA000"?Если нет, то нужна точка тут .Range.
Не совсем понял, я просто не силен в VBA. Мне нужно в коде дописать еще параметр?
Изменено: Денис Ш. - 17.10.2019 11:01:49
 
 
 
#11
17.10.2019 11:12:33
Код
.Range(.Cells(2, "D"), .Cells(LastRow + 1, "D")).ClearContents
Нужна точка перед Range в этой строке.
 
 
 
#12
17.10.2019 11:45:26
С точкой все равно не чистит.
Сделал так, тоже самое
Код
Sub COPY()
Dim iLastRow As Long, i As Long, LastRow As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("DATA000") 'ðàáîòàåì ñ ëèñòîì
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        Cells(LastRow + 1, "D").ClearContents
        'Range("D2:D10").ClearContents
        'Range(.Cells(2, "D"), .Cells(LastRow + 1, "D")).ClearContents
        LastRow = 1
        For i = 2 To iLastRow
                If InStr(1, Cells(i, "O"), "zag", vbTextCompare) <> 0 Then 'If Len(Cells(i, 3)) = 6 Then
                    Cells(i, "H").COPY .Cells(LastRow + 1, "D")
                    'Range(Cells(i, 8), Cells(i, 8)).Copy .Cells(LastRow + 1, 1)
                    LastRow = LastRow + 1
                End If
        Next
    End With
End Sub
Изменено: Денис Ш. - 17.10.2019 11:45:34
 
 
 
#13
17.10.2019 11:58:22
В приведённом примере точки нет.
 
 
 
#14
17.10.2019 11:59:55
Цитата
.Range(.Cells(2, "D"), .Cells(LastRow + 1, "D")).ClearContents
Денис Ш.
И где эта строка в Вашем примере?
Закоментирована?
Изменено: PITBY - 17.10.2019 12:04:25
 
 
 
#15
17.10.2019 12:34:44
МатросНаЗебре делал и с точкой и так. Документ весит 400 кб не могу выложить для примера
Изменено: Денис Ш. - 17.10.2019 13:23:28
 
 
 
#16
17.10.2019 12:45:16
А первый столбец у Вас случайно не пустой.
Если дело в этом, поменяйте строку на:
Код
LastRow = .Cells(Rows.Count, "D").End(xlUp).Row
 
 
 
#17
17.10.2019 12:49:37
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row - тут один лист
       Cells(LastRow + 1, "D").ClearContents - а тут уже другой!
P.S. Ну и вообще-то нужно бы привыкать и у Rows.Count указывать чьё значение берёте - бывали случаи что играло!
Изменено: Hugo - 17.10.2019 12:52:25
 
 
 
#18
17.10.2019 13:28:56
Такой вариант сработал
Код
Sub COPY()
Dim iLastRow As Long, i As Long, LastRow As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("DATA000")
        LastRow = .Cells(Rows.Count, "D").End(xlUp).Row
        'Cells(LastRow + 1, "D").ClearContents
        'Range("D2:D10").ClearContents
        .Range(.Cells(2, "D"), .Cells(LastRow + 1, "D")).ClearContents
        LastRow = 1
        For i = 2 To iLastRow
                If InStr(1, Cells(i, "O"), "zag", vbTextCompare) <> 0 Then 'If Len(Cells(i, 3)) = 6 Then
                    Cells(i, "H").COPY .Cells(LastRow + 1, "D")
                    'Range(Cells(i, 8), Cells(i, 8)).Copy .Cells(LastRow + 1, 1)
                    LastRow = LastRow + 1
                End If
        Next
    End With
End Sub
Скажите, а вот в этой строке не нужно 1 заменить на "D"?
Код
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row

Изменено: Денис Ш. - 17.10.2019 13:31:40
 
 
 
#19
17.10.2019 13:47:31
Лучше заменить на столбец, в котором поиск ведёте.
Код
iLastRow = Cells(Rows.Count, "O").End(xlUp).Row
 
 
 
#20
17.10.2019 13:49:42
А если допустим надо будет искать и копировать не в одном? Да, Вы были правы у меня первый столбец был пустой и из за этого не корректно работала. Я внес в него данные и все стало как надо. Но вот вопрос, если я буду искать и копировать не один столбец, могу использовать вот такой код:
Код
Sub COPY_TOLKO_ZAGOTOVITELNU()
Dim iLastRow As Long, i As Long, LastRow As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("DATA000")
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        'Cells(LastRow + 1, "D").ClearContents
        'Range("D2:D10").ClearContents
        .Range(.Cells(2, "D"), .Cells(LastRow + 1, "D")).ClearContents
        .Range(.Cells(2, "J"), .Cells(LastRow + 1, "J")).ClearContents
        .Range(.Cells(2, "P"), .Cells(LastRow + 1, "P")).ClearContents
        LastRow = 1
        For i = 2 To iLastRow
                If InStr(1, Cells(i, "O"), "zag", vbTextCompare) <> 0 Then
                    Cells(i, "H").COPY .Cells(LastRow + 1, "D")
                    Cells(i, "K").COPY .Cells(LastRow + 1, "J")
                    Cells(i, "I").COPY .Cells(LastRow + 1, "P")
                    LastRow = LastRow + 1
                End If
        Next
    End With
End Sub
 
Изменено: Денис Ш. - 17.10.2019 13:50:48
 
 
 
#21
17.10.2019 14:30:44
Цитата
Денис Ш. написал:
Я внес в него данные и все стало как надо.
Достаточно заменить на строку
Код
LastRow = .Cells(Rows.Count, "D").End(xlUp).Row

Цитата
Денис Ш. написал:
если я буду искать и копировать не один столбец, могу использовать вот такой код:
Выглядит вполне себе рабочим кодом.
 
 
 
#22
17.10.2019 15:14:50
МатросНаЗебре Вроде разобрался, появилась другая проблема. Если у меня в ячейке формула, то он копирует ее тоже, можно сделать чтобы копировал только значение?
 
 
 
#23
17.10.2019 15:17:17
Перестаньте валить все в кучу!!!
 
 
 
Страницы: 1
Наверх