Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Копирование данных из одной таблицы в другую по значению... - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование данных из одной таблицы в другую по значению... (Иное/Other)
Копирование данных из одной таблицы в другую по значению...
damask_86ru Дата: Среда, 04.11.2015, 17:02 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
Доброго времени суток!
В приложенном файле на "Лист 1" имеется таблица, и такая же таблица на "Лист 2".
В модуле "Лист 1" прописал код который срабатывает при выделении ячейки столбца "E".
Распишу, что он должен делать:
Если в ячейке столбца "B" "Лист 1" значение "S", тогда данные строки активной ячейки "Лист 1" должны копироваться в таблицу на "Лист 2" (при этом определить последнюю заполненную ячейку "Листа 2" по столбцу "B", и записать данные на строку ниже). А если в ячейке столбца "B" "Лист 1" значение "M", тогда ничего.
Вроде бы код работает, но как то не так как надо ... помогите разобраться.
К сообщению приложен файл: 4439105.xls (27.5 Kb)
 
Ответить
СообщениеДоброго времени суток!
В приложенном файле на "Лист 1" имеется таблица, и такая же таблица на "Лист 2".
В модуле "Лист 1" прописал код который срабатывает при выделении ячейки столбца "E".
Распишу, что он должен делать:
Если в ячейке столбца "B" "Лист 1" значение "S", тогда данные строки активной ячейки "Лист 1" должны копироваться в таблицу на "Лист 2" (при этом определить последнюю заполненную ячейку "Листа 2" по столбцу "B", и записать данные на строку ниже). А если в ячейке столбца "B" "Лист 1" значение "M", тогда ничего.
Вроде бы код работает, но как то не так как надо ... помогите разобраться.
Автор - damask_86ru
Дата добавления - 04.11.2015 в 17:02
RAN Дата: Среда, 04.11.2015, 17:26 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
    lLastRow = sheet1.Cells(sheet1.Rows.Count, "B").End(xlUp).Row - 0
[/vba]
ну очень хитро. если из 5 не вычесть 0 то 5 никак не получится... :)
[vba]
Код
lLastRow = 5
lLastRow  = 20
sheet2.Cells(lLastRow, "B").Value = sheet1.Cells(lLastRow, "B").Value
[/vba]
работает, как заказано, копирует из строки 20 одного листа, в строку 20 другого.

Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
    lLastRow = sheet1.Cells(sheet1.Rows.Count, "B").End(xlUp).Row - 0
[/vba]
ну очень хитро. если из 5 не вычесть 0 то 5 никак не получится... :)
[vba]
Код
lLastRow = 5
lLastRow  = 20
sheet2.Cells(lLastRow, "B").Value = sheet1.Cells(lLastRow, "B").Value
[/vba]
работает, как заказано, копирует из строки 20 одного листа, в строку 20 другого.
Автор - RAN
Дата добавления - 04.11.2015 в 17:26
damask_86ru Дата: Среда, 04.11.2015, 19:57 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lLastRow As Long
    'определяем последнюю заполненную строку листа sheet1 по столбцу "B"
    lLastRow = sheet1.Cells(sheet1.Rows.Count, "B").End(xlUp).Row - 0
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        If ActiveSheet.Cells(lLastRow, "B").Value = "S" Then
            'определяем последнюю заполненную строку листа sheet2 по столбцу "B"
            lLastRow = sheet2.Cells(sheet2.Rows.Count, "B").End(xlUp).Row + 1
            'заносим данные с таблицы sheet1 на sheet2
            lLastRow = 3
            sheet2.Cells(lLastRow, "B").Value = sheet1.Cells(lLastRow, "B").Value
            sheet2.Cells(lLastRow, "C").Value = sheet1.Cells(lLastRow, "C").Value
            sheet2.Cells(lLastRow, "D").Value = sheet1.Cells(lLastRow, "D").Value
        End If
    End If
End Sub
[/vba]
Таким образом я рассчитывал привязать код к активной строке, т.е. при последовательном заполнении таблицы на "Лист 1" активируя ячейку столбца "E",
если ячейка активной строки столбца "B" имеет значение "S" код срабатывает и копирует данные активной строки в таблицу на "Лист 2"
(при этом определяет последнюю заполненную строку в таблице на "Листе 2", и заносит данные в следующую строку).


Сообщение отредактировал damask_86ru - Среда, 04.11.2015, 19:58
 
Ответить
Сообщение[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lLastRow As Long
    'определяем последнюю заполненную строку листа sheet1 по столбцу "B"
    lLastRow = sheet1.Cells(sheet1.Rows.Count, "B").End(xlUp).Row - 0
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        If ActiveSheet.Cells(lLastRow, "B").Value = "S" Then
            'определяем последнюю заполненную строку листа sheet2 по столбцу "B"
            lLastRow = sheet2.Cells(sheet2.Rows.Count, "B").End(xlUp).Row + 1
            'заносим данные с таблицы sheet1 на sheet2
            lLastRow = 3
            sheet2.Cells(lLastRow, "B").Value = sheet1.Cells(lLastRow, "B").Value
            sheet2.Cells(lLastRow, "C").Value = sheet1.Cells(lLastRow, "C").Value
            sheet2.Cells(lLastRow, "D").Value = sheet1.Cells(lLastRow, "D").Value
        End If
    End If
End Sub
[/vba]
Таким образом я рассчитывал привязать код к активной строке, т.е. при последовательном заполнении таблицы на "Лист 1" активируя ячейку столбца "E",
если ячейка активной строки столбца "B" имеет значение "S" код срабатывает и копирует данные активной строки в таблицу на "Лист 2"
(при этом определяет последнюю заполненную строку в таблице на "Листе 2", и заносит данные в следующую строку).
Автор - damask_86ru
Дата добавления - 04.11.2015 в 19:57
_Boroda_ Дата: Среда, 04.11.2015, 20:09 | Сообщение № 4
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16675
Репутация: 6481 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Так нужно?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lLastRow As Long
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        If Target = "S" Then
            lLastRow = sheet2.Cells(sheet2.Rows.Count, "B").End(xlUp).Row + 1
            sheet2.Cells(lLastRow, "B").Resize(, 4) = sheet1.Cells(Target.Row, "B").Resize(, 4).Value
        End If
    End If
End Sub
[/vba]
К сообщению приложен файл: 4439105_1.xls (33.5 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТак нужно?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lLastRow As Long
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        If Target = "S" Then
            lLastRow = sheet2.Cells(sheet2.Rows.Count, "B").End(xlUp).Row + 1
            sheet2.Cells(lLastRow, "B").Resize(, 4) = sheet1.Cells(Target.Row, "B").Resize(, 4).Value
        End If
    End If
End Sub
[/vba]
Автор - _Boroda_
Дата добавления - 04.11.2015 в 20:09
damask_86ru Дата: Четверг, 05.11.2015, 06:47 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
_Boroda_, вы могли бы объяснить как это работает:
[vba]
Код
sheet2.Cells(lLastRow, "B").Resize(, 4) = sheet1.Cells(Target.Row, "B").Resize(, 4).Value
[/vba]
 
Ответить
Сообщение_Boroda_, вы могли бы объяснить как это работает:
[vba]
Код
sheet2.Cells(lLastRow, "B").Resize(, 4) = sheet1.Cells(Target.Row, "B").Resize(, 4).Value
[/vba]
Автор - damask_86ru
Дата добавления - 05.11.2015 в 06:47
damask_86ru Дата: Четверг, 05.11.2015, 10:54 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
_Boroda_, с данной строкой разобрался:
[vba]
Код
sheet2.Cells(lLastRow, "B").Resize(, 4) = sheet1.Cells(Target.Row, "B").Resize(, 4).Value
[/vba]
Копирует данные четырех последующих ячеек "B, C, D, E". Извиняюсь, что не написал об этом в самом начале, необходимо чтобы была
возможность копировать данные не из всех столбцов, а выборочно, например: "A, C, D".

И еще один момент, код срабатывает при изменении в ячейке "B", т.е. когда ее изменяешь, а это уже не последовательно.
Необходимо чтобы код срабатывал при выборе (активации) ячейки столбца "E" по значению в ячейке столбца "B".
 
Ответить
Сообщение_Boroda_, с данной строкой разобрался:
[vba]
Код
sheet2.Cells(lLastRow, "B").Resize(, 4) = sheet1.Cells(Target.Row, "B").Resize(, 4).Value
[/vba]
Копирует данные четырех последующих ячеек "B, C, D, E". Извиняюсь, что не написал об этом в самом начале, необходимо чтобы была
возможность копировать данные не из всех столбцов, а выборочно, например: "A, C, D".

И еще один момент, код срабатывает при изменении в ячейке "B", т.е. когда ее изменяешь, а это уже не последовательно.
Необходимо чтобы код срабатывал при выборе (активации) ячейки столбца "E" по значению в ячейке столбца "B".
Автор - damask_86ru
Дата добавления - 05.11.2015 в 10:54
_Boroda_ Дата: Четверг, 05.11.2015, 12:58 | Сообщение № 7
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16675
Репутация: 6481 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Тогда так. Не совсем, правда, понимаю тайный смысл всего этого, ну да Вам виднее.
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        If Target.Offset(, -3) = "S" Then
            lLastRow = sheet2.Cells(sheet2.Rows.Count, "B").End(xlUp).Row + 1
            sheet2.Cells(lLastRow, "C") = sheet1.Cells(Target.Row, "C").Value
            sheet2.Cells(lLastRow, "D") = sheet1.Cells(Target.Row, "D").Value
            'Размножаете строку выше сколько нужно раз для выборочного переноса
        End If
    End If
End Sub
[/vba]
К сообщению приложен файл: 4439105_2.xls (34.5 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТогда так. Не совсем, правда, понимаю тайный смысл всего этого, ну да Вам виднее.
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        If Target.Offset(, -3) = "S" Then
            lLastRow = sheet2.Cells(sheet2.Rows.Count, "B").End(xlUp).Row + 1
            sheet2.Cells(lLastRow, "C") = sheet1.Cells(Target.Row, "C").Value
            sheet2.Cells(lLastRow, "D") = sheet1.Cells(Target.Row, "D").Value
            'Размножаете строку выше сколько нужно раз для выборочного переноса
        End If
    End If
End Sub
[/vba]
Автор - _Boroda_
Дата добавления - 05.11.2015 в 12:58
damask_86ru Дата: Четверг, 05.11.2015, 20:33 | Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
_Boroda_, спасибо Вам за отклик, но все таки не так...
Во вложении файл, если есть желание посмотрите, чего я добивался. Таблицы конечно условные, но вроде заработало как надо.
Значения из таблицы 1 забирал через ActiveCells.Offset, а вносил ...
Вообщем посмотрите файл.
К сообщению приложен файл: 5002678.xlsm (20.1 Kb)
 
Ответить
Сообщение_Boroda_, спасибо Вам за отклик, но все таки не так...
Во вложении файл, если есть желание посмотрите, чего я добивался. Таблицы конечно условные, но вроде заработало как надо.
Значения из таблицы 1 забирал через ActiveCells.Offset, а вносил ...
Вообщем посмотрите файл.
Автор - damask_86ru
Дата добавления - 05.11.2015 в 20:33
Wasilich Дата: Четверг, 05.11.2015, 21:28 | Сообщение № 9
Группа: Друзья
Ранг: Старожил
Сообщений: 1232
Репутация: 326 ±
Замечаний: 0% ±

2003
Может так будет понятней :)
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("E:E")) Is Nothing Then
     If Target = "Винт" Then
        ts = Selection.Row 'строка ячейки выбора
        With Sheets("Винт")
            ps = .Range("F" & Rows.Count).End(xlUp).Row + 1
            .Cells(ps, "D") = Cells(ts, "D")
            .Cells(ps, "F") = Cells(ts, "F")
            .Cells(ps, "G") = Cells(ts, "G")
            .Cells(ps, "H") = Cells(ts, "H")
        End With
     End If
  End If
End Sub
[/vba]


Сообщение отредактировал Wasilic - Пятница, 06.11.2015, 11:59
 
Ответить
СообщениеМожет так будет понятней :)
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("E:E")) Is Nothing Then
     If Target = "Винт" Then
        ts = Selection.Row 'строка ячейки выбора
        With Sheets("Винт")
            ps = .Range("F" & Rows.Count).End(xlUp).Row + 1
            .Cells(ps, "D") = Cells(ts, "D")
            .Cells(ps, "F") = Cells(ts, "F")
            .Cells(ps, "G") = Cells(ts, "G")
            .Cells(ps, "H") = Cells(ts, "H")
        End With
     End If
  End If
End Sub
[/vba]
Автор - Wasilich
Дата добавления - 05.11.2015 в 21:28
damask_86ru Дата: Пятница, 06.11.2015, 06:03 | Сообщение № 10
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
Wasilic, спасибо. Но пока остановлюсь на этом:
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lLastRow As Long
If Not Intersect(Target, Range("K:K")) Is Nothing Then
    If ActiveCell.Offset(0, -6).Value = "Винт" Then                    'если в ячейке "E" значение "Винт"
        lLastRow = sheet2.Cells(sheet2.Rows.Count, "D").End(xlUp).Row + 1  'определяем последнюю заполненную строку листа sheet2 по столбцу "D"
        sheet2.Cells(lLastRow, "D").Value = ActiveCell.Offset(0, -7).Value        'заносим данные из таблицы 1 в таблицу 2
        sheet2.Cells(lLastRow, "F").Value = ActiveCell.Offset(0, -5).Value
        sheet2.Cells(lLastRow, "G").Value = ActiveCell.Offset(0, -4).Value
        sheet2.Cells(lLastRow, "H").Value = ActiveCell.Offset(0, -3).Value
    End If
End If
End Sub
[/vba]
 
Ответить
СообщениеWasilic, спасибо. Но пока остановлюсь на этом:
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lLastRow As Long
If Not Intersect(Target, Range("K:K")) Is Nothing Then
    If ActiveCell.Offset(0, -6).Value = "Винт" Then                    'если в ячейке "E" значение "Винт"
        lLastRow = sheet2.Cells(sheet2.Rows.Count, "D").End(xlUp).Row + 1  'определяем последнюю заполненную строку листа sheet2 по столбцу "D"
        sheet2.Cells(lLastRow, "D").Value = ActiveCell.Offset(0, -7).Value        'заносим данные из таблицы 1 в таблицу 2
        sheet2.Cells(lLastRow, "F").Value = ActiveCell.Offset(0, -5).Value
        sheet2.Cells(lLastRow, "G").Value = ActiveCell.Offset(0, -4).Value
        sheet2.Cells(lLastRow, "H").Value = ActiveCell.Offset(0, -3).Value
    End If
End If
End Sub
[/vba]
Автор - damask_86ru
Дата добавления - 06.11.2015 в 06:03
RAN Дата: Пятница, 06.11.2015, 10:01 | Сообщение № 11
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Для чего сюда ActiveCell приплетать?
В данной процедуре Target это выделенный диапазон.
Если выделяется одна ячейка, то
[vba]
Код
ActiveCell = Target
[/vba]
если несколько, то
[vba]
Код
ActiveCell = Target(1)
[/vba]
(первая ячейка выделения)

Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеДля чего сюда ActiveCell приплетать?
В данной процедуре Target это выделенный диапазон.
Если выделяется одна ячейка, то
[vba]
Код
ActiveCell = Target
[/vba]
если несколько, то
[vba]
Код
ActiveCell = Target(1)
[/vba]
(первая ячейка выделения)
Автор - RAN
Дата добавления - 06.11.2015 в 10:01
damask_86ru Дата: Пятница, 06.11.2015, 18:25 | Сообщение № 12
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
RAN, поверьте, я вообще "дуб" в этом деле (vba), и что лучше, я даже не знаю.
Просто я понял, что ActiveCell это выделенная ячейка, а с помощью Offset можно сместится в нужный диапазон...
Главное получилось, то что задумывал, работает! Результат выложил. А всем откликнувшимся большое СПАСИБО!
 
Ответить
СообщениеRAN, поверьте, я вообще "дуб" в этом деле (vba), и что лучше, я даже не знаю.
Просто я понял, что ActiveCell это выделенная ячейка, а с помощью Offset можно сместится в нужный диапазон...
Главное получилось, то что задумывал, работает! Результат выложил. А всем откликнувшимся большое СПАСИБО!
Автор - damask_86ru
Дата добавления - 06.11.2015 в 18:25
damask_86ru Дата: Пятница, 06.11.2015, 19:15 | Сообщение № 13
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
У меня есть еще один вопрос, по поводу: исключить повторное копирование данных из таблицы 1 в таблицу 2.
Или необходимо создать для этого отдельную тему?
[moder]Да, отдельную


Сообщение отредактировал _Boroda_ - Пятница, 06.11.2015, 22:22
 
Ответить
СообщениеУ меня есть еще один вопрос, по поводу: исключить повторное копирование данных из таблицы 1 в таблицу 2.
Или необходимо создать для этого отдельную тему?
[moder]Да, отдельную
Автор - damask_86ru
Дата добавления - 06.11.2015 в 19:15
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование данных из одной таблицы в другую по значению... (Иное/Other)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!