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

Вход

Регистрация

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

 

= Мир MS Excel/копирование из другого файла по условию - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » копирование из другого файла по условию (Макросы/Sub)
копирование из другого файла по условию
urlchik Дата: Среда, 06.06.2018, 13:28 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 31
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте, спецы!
Помогите пожалуйста с задачкой. В ВБА я полный 0! Есть два файла FIO.xlsx и Phone.xlsx оба содержат столбец с ФИО. Нужно скопировать из Phone.xlsx столбцы телефон и почта в FIO.xlsx лист Сотр. и столбцы Город и ИН в FIO.xlsx лист ИД.

Логику понимаю, а закодировать не могу! Как собака - понимаю, но сказать не могу :-).

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

Заранее благодарю!
К сообщению приложен файл: FIO.xlsx(9.6 Kb) · Phone.xlsx(10.3 Kb)


Век живи - век учись!
 
Ответить
СообщениеЗдравствуйте, спецы!
Помогите пожалуйста с задачкой. В ВБА я полный 0! Есть два файла FIO.xlsx и Phone.xlsx оба содержат столбец с ФИО. Нужно скопировать из Phone.xlsx столбцы телефон и почта в FIO.xlsx лист Сотр. и столбцы Город и ИН в FIO.xlsx лист ИД.

Логику понимаю, а закодировать не могу! Как собака - понимаю, но сказать не могу :-).

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

Заранее благодарю!

Автор - urlchik
Дата добавления - 06.06.2018 в 13:28
boa Дата: Среда, 06.06.2018, 14:58 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 134
Репутация: 20 ±
Замечаний: 0% ±

2013, 2016
А зачем VBA?
Это все решает ВПР(VLOOKUP)
К сообщению приложен файл: 7342300.xlsx(15.0 Kb)


 
Ответить
СообщениеА зачем VBA?
Это все решает ВПР(VLOOKUP)

Автор - boa
Дата добавления - 06.06.2018 в 14:58
urlchik Дата: Среда, 06.06.2018, 17:21 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 31
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
А зачем VBA?
Это все решает ВПР(VLOOKUP)

ВПР-ом я делаю, но хотелось-бы сие чудо смонтировать в ВБА, так как файлики по логике совместимы с оригинальными, но данных в них гораздо больше - не хотелось бы в каждую ячейку тулить формулу


Век живи - век учись!
 
Ответить
Сообщение
А зачем VBA?
Это все решает ВПР(VLOOKUP)

ВПР-ом я делаю, но хотелось-бы сие чудо смонтировать в ВБА, так как файлики по логике совместимы с оригинальными, но данных в них гораздо больше - не хотелось бы в каждую ячейку тулить формулу

Автор - urlchik
Дата добавления - 06.06.2018 в 17:21
Mikael Дата: Четверг, 07.06.2018, 14:21 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 80
Репутация: 31 ±
Замечаний: 0% ±

Excel 2010
Доброго дня!
Так хотели?
[vba]
Код
Sub pmai()
    Dim rCell As Range, rng As Range, rTable As Range, lc1&, lc2&
    
    Set rng = Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)
    On Error Resume Next
    Dim wb As Workbook: Set wb = Workbooks("Phone.xlsx")    'тут указать ИМЯ книги
    If Err Then MsgBox "Откройте книгу Phone.xlsx", vbCritical, "pmaiERR": Exit Sub
    
    Set rTable = wb.Worksheets("Лист1").UsedRange   'тут указать ИМЯ листа
    If Err Then MsgBox "Убедитесь в наличии листа Лист1 в книге Phone.xlsx", vbCritical, "pmaiERR": Exit Sub
    
    lc1 = rTable.Find([c1], rTable(rTable.Count), , xlWhole).Column
    lc2 = rTable.Find([d1], rTable(rTable.Count), , xlWhole).Column
    
    For Each rCell In rng
        If lc1 > 0 Then rCell.Offset(, 2) = WorksheetFunction.VLookup(rCell, rTable, lc1) Else rCell.Offset(, 2) = "Не найден столбец " & [c1]
        If lc2 > 0 Then rCell.Offset(, 3) = WorksheetFunction.VLookup(rCell, rTable, lc2) Else rCell.Offset(, 3) = "Не найден столбец " & [d1]
    Next rCell
End Sub
[/vba]

Работает только для столбцов С и D. Должна быть открыта книга откуда берутся данные (Phone.xlsx).
К сообщению приложен файл: FIO_.xlsm(20.3 Kb)
 
Ответить
СообщениеДоброго дня!
Так хотели?
[vba]
Код
Sub pmai()
    Dim rCell As Range, rng As Range, rTable As Range, lc1&, lc2&
    
    Set rng = Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)
    On Error Resume Next
    Dim wb As Workbook: Set wb = Workbooks("Phone.xlsx")    'тут указать ИМЯ книги
    If Err Then MsgBox "Откройте книгу Phone.xlsx", vbCritical, "pmaiERR": Exit Sub
    
    Set rTable = wb.Worksheets("Лист1").UsedRange   'тут указать ИМЯ листа
    If Err Then MsgBox "Убедитесь в наличии листа Лист1 в книге Phone.xlsx", vbCritical, "pmaiERR": Exit Sub
    
    lc1 = rTable.Find([c1], rTable(rTable.Count), , xlWhole).Column
    lc2 = rTable.Find([d1], rTable(rTable.Count), , xlWhole).Column
    
    For Each rCell In rng
        If lc1 > 0 Then rCell.Offset(, 2) = WorksheetFunction.VLookup(rCell, rTable, lc1) Else rCell.Offset(, 2) = "Не найден столбец " & [c1]
        If lc2 > 0 Then rCell.Offset(, 3) = WorksheetFunction.VLookup(rCell, rTable, lc2) Else rCell.Offset(, 3) = "Не найден столбец " & [d1]
    Next rCell
End Sub
[/vba]

Работает только для столбцов С и D. Должна быть открыта книга откуда берутся данные (Phone.xlsx).

Автор - Mikael
Дата добавления - 07.06.2018 в 14:21
urlchik Дата: Пятница, 08.06.2018, 13:17 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 31
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Доброго дня!
Так хотели?

О! Да! СПАСИБО!

Теперь почитаю - как вытягивать данные не открывая книги )

А что поменять, чтоб работало для других столбцов?
я так понимаю - rCell.Offset(, 2) поменять 2 на другой номер столбца!

А добавить еще данные то - добавить lc3&... и все что с ним связано...lc3 = rTable.Find([е1], rTable(rTable.Count), , xlWhole).Column
и т.д.

Правильно?
Еще раз СПАСИБО! Плюсую


Век живи - век учись!
 
Ответить
Сообщение
Доброго дня!
Так хотели?

О! Да! СПАСИБО!

Теперь почитаю - как вытягивать данные не открывая книги )

А что поменять, чтоб работало для других столбцов?
я так понимаю - rCell.Offset(, 2) поменять 2 на другой номер столбца!

А добавить еще данные то - добавить lc3&... и все что с ним связано...lc3 = rTable.Find([е1], rTable(rTable.Count), , xlWhole).Column
и т.д.

Правильно?
Еще раз СПАСИБО! Плюсую

Автор - urlchik
Дата добавления - 08.06.2018 в 13:17
Mikael Дата: Пятница, 08.06.2018, 14:48 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 80
Репутация: 31 ±
Замечаний: 0% ±

Excel 2010
urlchik, в целом да, только в rCell.Offset(, 2) "2" это не номер столбца, а смещение на 2 столбца вправо от текущей ячейки rCell.

Теперь почитаю - как вытягивать данные не открывая книги
Тогда поройте в направлении ExecuteExcel4Macro.

На мой взгляд проще отключить обновление экрана, открыть нужную книгу, а потом закрыть. Например, так:


Лично я бы предпочел дать возможность пользователю самому выбирать файл из которого берутся данные:


UPD:
К сообщению приложен файл: FIO_2.xlsm(25.3 Kb)


Сообщение отредактировал Mikael - Пятница, 08.06.2018, 15:38
 
Ответить
Сообщениеurlchik, в целом да, только в rCell.Offset(, 2) "2" это не номер столбца, а смещение на 2 столбца вправо от текущей ячейки rCell.

Теперь почитаю - как вытягивать данные не открывая книги
Тогда поройте в направлении ExecuteExcel4Macro.

На мой взгляд проще отключить обновление экрана, открыть нужную книгу, а потом закрыть. Например, так:


Лично я бы предпочел дать возможность пользователю самому выбирать файл из которого берутся данные:


UPD:

Автор - Mikael
Дата добавления - 08.06.2018 в 14:48
StoTisteg Дата: Пятница, 08.06.2018, 16:39 | Сообщение № 7
Группа: Авторы
Ранг: Ветеран
Сообщений: 920
Репутация: 78 ±
Замечаний: 0% ±

Excel 2010
Mikael, я быещё добавил проверку, выбрал ли пользователь вообще что-то.


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеMikael, я быещё добавил проверку, выбрал ли пользователь вообще что-то.

Автор - StoTisteg
Дата добавления - 08.06.2018 в 16:39
Mikael Дата: Пятница, 08.06.2018, 16:51 | Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 80
Репутация: 31 ±
Замечаний: 0% ±

Excel 2010
StoTisteg, мое упущение, спасибо за подсказку! :)
Конечно, пользователь же может нажать отмену или крестик диалогового окна, что вернет пустой адрес книги и вызовет ошибку, поэтому после вызова функции нужно добавить:
[vba]
Код
If Err Then Exit Sub
[/vba]
К сообщению приложен файл: FIO_2.1.xlsm(25.5 Kb)
 
Ответить
СообщениеStoTisteg, мое упущение, спасибо за подсказку! :)
Конечно, пользователь же может нажать отмену или крестик диалогового окна, что вернет пустой адрес книги и вызовет ошибку, поэтому после вызова функции нужно добавить:
[vba]
Код
If Err Then Exit Sub
[/vba]

Автор - Mikael
Дата добавления - 08.06.2018 в 16:51
urlchik Дата: Суббота, 09.06.2018, 15:30 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 31
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Mikael! Спасибо огромное! Вы супер!


Век живи - век учись!
 
Ответить
СообщениеMikael! Спасибо огромное! Вы супер!

Автор - urlchik
Дата добавления - 09.06.2018 в 15:30
Мир MS Excel » Вопросы и решения » Вопросы по VBA » копирование из другого файла по условию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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