Добрый день. Обращаюсь за помощью. Столкнулась на работе с необходимостью писать макрос, опыта ноль...такая работа! Итак, две книги. Первая-имеет колонки с А по Р, вторая- 7 колонок с А по G Нужно эти две книги объединить в одну по условию: Книга1.Поле I = Книга2.Поле В и Книга1.Поле L = Книга2.Поле А
Для наглядности примеры двух книг, из которых нужно сделать одну, вложила два файла
Добрый день. Обращаюсь за помощью. Столкнулась на работе с необходимостью писать макрос, опыта ноль...такая работа! Итак, две книги. Первая-имеет колонки с А по Р, вторая- 7 колонок с А по G Нужно эти две книги объединить в одну по условию: Книга1.Поле I = Книга2.Поле В и Книга1.Поле L = Книга2.Поле А
Для наглядности примеры двух книг, из которых нужно сделать одну, вложила два файлакофемолка
новую книгу создать, чтобы она тянула данные из книга1 и книга2. Ну или можно сделать пустой ексель, в нем кнопка "счастье", которая тянет все это добро...
новую книгу создать, чтобы она тянула данные из книга1 и книга2. Ну или можно сделать пустой ексель, в нем кнопка "счастье", которая тянет все это добро...кофемолка
Попробуйте записать ваши действия по переносу данных макрорекордером. Обе книги должны быть открыты. Объединенные ячейки второго файла будут определенной трудностью при переносе.
Попробуйте записать ваши действия по переносу данных макрорекордером. Обе книги должны быть открыты. Объединенные ячейки второго файла будут определенной трудностью при переносе.Kuzmich
Сообщение отредактировал Kuzmich - Четверг, 17.12.2015, 13:18
знатоки, Kuzmich, а не подскажете, в чем конфликт? На одной из машин польз-ля выходит ошибка (виндовс7, офис 10) run-time error "9" subscript out of range
debug встает на строку с --- [vba]
Код
With Workbooks("Источник1").Worksheets("1")
[/vba] ---- [vba]
Код
Option Explicit
Sub Автофигура2_Щелкнуть() Dim iLastRow As Long With Workbooks("Источник1").Worksheets("1") .UsedRange.Copy Range("A2") End With With Workbooks("Источник2").Worksheets("TDSheet") iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row .Range("B11:B" & iLastRow).Copy Range("I3") .Range("A11:A" & iLastRow).Copy Range("L3") End With End Sub
[/vba] [moder]Коди макросов нужно обрамлять тегами. Кнопка #. На первый раз поправил.
знатоки, Kuzmich, а не подскажете, в чем конфликт? На одной из машин польз-ля выходит ошибка (виндовс7, офис 10) run-time error "9" subscript out of range
debug встает на строку с --- [vba]
Код
With Workbooks("Источник1").Worksheets("1")
[/vba] ---- [vba]
Код
Option Explicit
Sub Автофигура2_Щелкнуть() Dim iLastRow As Long With Workbooks("Источник1").Worksheets("1") .UsedRange.Copy Range("A2") End With With Workbooks("Источник2").Worksheets("TDSheet") iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row .Range("B11:B" & iLastRow).Copy Range("I3") .Range("A11:A" & iLastRow).Copy Range("L3") End With End Sub
[/vba] [moder]Коди макросов нужно обрамлять тегами. Кнопка #. На первый раз поправил.кофемолка
кофемолка, просто я обратил внимание, что в файле, который Вам приложил Kuzmich в своём ответе (Сообщение № 7) в файле листы называются аля "Лист1" у Вас же в макросе указано что лист называется "1". Если лист действительно 1-й то можно убрать кавычки просто оставить [vba]
Код
With Workbooks("Источник1").Worksheets(1)
[/vba]тогда это будет обращение к первому листу (по индексу листа).
кофемолка, просто я обратил внимание, что в файле, который Вам приложил Kuzmich в своём ответе (Сообщение № 7) в файле листы называются аля "Лист1" у Вас же в макросе указано что лист называется "1". Если лист действительно 1-й то можно убрать кавычки просто оставить [vba]
Код
With Workbooks("Источник1").Worksheets(1)
[/vba]тогда это будет обращение к первому листу (по индексу листа).Roman777
Много чего не знаю!!!!
Сообщение отредактировал Roman777 - Пятница, 18.12.2015, 14:06
Roman777, в реальных книгах лист называется совсем по-другому. Здесь я оставила "1" , для примера. Я говорю, что запускаю этот же макрос на своей машине с теми же файлами и все ок, а на машине польз-ля ошибка.
Roman777, в реальных книгах лист называется совсем по-другому. Здесь я оставила "1" , для примера. Я говорю, что запускаю этот же макрос на своей машине с теми же файлами и все ок, а на машине польз-ля ошибка.кофемолка
Я думаю, что наличие такой галочки не должно влиять на работу макроса. А вот пробелы в названии книги или листа приведут к ошибке. Например, "Источник1 " с пробелом в конце. Листы у вас были с названиями Лист1 и TDSheet
Цитата
Разобралась:
Я думаю, что наличие такой галочки не должно влиять на работу макроса. А вот пробелы в названии книги или листа приведут к ошибке. Например, "Источник1 " с пробелом в конце. Листы у вас были с названиями Лист1 и TDSheetKuzmich
Kuzmich, начала пользоваться творением. И такое ощущение, что кнопка "Счастья" собирает из двух книг одну, минуя условия связи книг между собой (Книга1.Поле I = Книга2.Поле В и Книга1.Поле L = Книга2.Поле А) Связи не установлены. И еще из второй книги не все столбцы тянутся в общую книгу. Вы не подскажете, в чем проблема?
Kuzmich, начала пользоваться творением. И такое ощущение, что кнопка "Счастья" собирает из двух книг одну, минуя условия связи книг между собой (Книга1.Поле I = Книга2.Поле В и Книга1.Поле L = Книга2.Поле А) Связи не установлены. И еще из второй книги не все столбцы тянутся в общую книгу. Вы не подскажете, в чем проблема?кофемолка
Sub tt() Dim r1 As Range, r2 As Range, wb As Workbook, c As Range Dim t$, i&
Application.ScreenUpdating = False
Set r1 = Workbooks("6665066.xlsx").Sheets(1).[a1].CurrentRegion Set r2 = Workbooks("9581531.xlsx").Sheets(1).[a8].CurrentRegion Set wb = Workbooks.Add(1)
With CreateObject("scripting.dictionary"): .comparemode = 1 For Each c In r1.Columns(9).Cells .Item(c.Text & "|" & c.Offset(, 3).Text) = c.Row Next For Each c In r2.Columns(1).Cells t = c.Offset(, 1).Text & "|" & c.Text If .exists(t) Then i = i + 1 r1.Rows(.Item(t)).Copy wb.Sheets(1).Cells(i, 1) c.Resize(, 7).Copy wb.Sheets(1).Cells(i, 17) End If Next End With
wb.Sheets(1).UsedRange.EntireColumn.AutoFit Application.ScreenUpdating = True End Sub
[/vba]
Для работающих в Windows: [vba]
Код
Option Explicit
Sub tt() Dim r1 As Range, r2 As Range, wb As Workbook, c As Range Dim t$, i&
Application.ScreenUpdating = False
Set r1 = Workbooks("6665066.xlsx").Sheets(1).[a1].CurrentRegion Set r2 = Workbooks("9581531.xlsx").Sheets(1).[a8].CurrentRegion Set wb = Workbooks.Add(1)
With CreateObject("scripting.dictionary"): .comparemode = 1 For Each c In r1.Columns(9).Cells .Item(c.Text & "|" & c.Offset(, 3).Text) = c.Row Next For Each c In r2.Columns(1).Cells t = c.Offset(, 1).Text & "|" & c.Text If .exists(t) Then i = i + 1 r1.Rows(.Item(t)).Copy wb.Sheets(1).Cells(i, 1) c.Resize(, 7).Copy wb.Sheets(1).Cells(i, 17) End If Next End With
wb.Sheets(1).UsedRange.EntireColumn.AutoFit Application.ScreenUpdating = True End Sub
Kuzmich, нужно все колонки из двух книг перенеси в общую книгу (кроме А и В второй книги,так как они уже присуствуют в первой). А условие-сопадение одновременно колонки I первой книги с колонкой В второй книги и колонки L первой книги с колонкой A второй книги.
Kuzmich, нужно все колонки из двух книг перенеси в общую книгу (кроме А и В второй книги,так как они уже присуствуют в первой). А условие-сопадение одновременно колонки I первой книги с колонкой В второй книги и колонки L первой книги с колонкой A второй книги.кофемолка