Данный макрос позволяет копировать строки выбранных ячеек во внешний файл Excel. Удобно использовать при постепенной "ручной" выборке значений из большой таблицы. Предложенное KuklP решение позволяет настолько сократить время обращения на запись к файлу-накопителю данных, что не должно возникать конфликтов при одновременном его заполнении несколькими пользователями. Выбранные строки копируются вместе с форматами и формулами. Естественно, если формула в строке ссылается на значения других строк, то возможны ошибки. Выбранные ячейки не обязательно должны составлять непрерывный диапазон. Возможно выделение не смежных ячеек (выбранных через Ctrl или отфильтрованных). 1. В файле-источнике данных необходимо запускать макрос: [vba]
Код
Sub Copy_ROWs_to_EXT_FILE() ' скопировать строки выделенных ячеек во внешний файл-накопитель '--------------------------------------------------------------------------------------- ' Procedure : Copy_ROWs_to_EXT_FILE ' Author : KuklP & Alex_ST ' Topic_HEADER : Макрос "Copy_ROWs_to_EXT_FILE" ' Topic_URL : http://www.excelworld.ru/forum/3-176-2008-16-1293625247 ' DateTime : 29.12.10, 15:20 ' Purpose : скопировать строки выделенных ячеек во внешний файл-накопитель ' Notes : после работы макроса файл-накопитель становится невидимым в обычных окнах Excel (как надстройка или Personal.xls) '--------------------------------------------------------------------------------------- If Not TypeName(Selection) = "Range" Then Exit Sub Dim lr&, wb As Workbook, lb As Workbook With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With Set wb = GetObject("c:\test.xls") 'путь к файлу-накопителю Set lb = ThisWorkbook lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1) wb.Close (True) ' закрыть с сохранением With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With Set wb = Nothing: Set lb = Nothing End Sub
[/vba]
2. Чтобы после работы макроса файл-накопитель не становился невидимым в окнах Excel (как надстройка или Personal.xls), в нём нужно прописать: [vba]
Код
Private Sub Workbook_Open() If Me.Parent.Caption = Application.Caption Then Windows(Me.Name).Visible = True End Sub
[/vba]
Данный макрос позволяет копировать строки выбранных ячеек во внешний файл Excel. Удобно использовать при постепенной "ручной" выборке значений из большой таблицы. Предложенное KuklP решение позволяет настолько сократить время обращения на запись к файлу-накопителю данных, что не должно возникать конфликтов при одновременном его заполнении несколькими пользователями. Выбранные строки копируются вместе с форматами и формулами. Естественно, если формула в строке ссылается на значения других строк, то возможны ошибки. Выбранные ячейки не обязательно должны составлять непрерывный диапазон. Возможно выделение не смежных ячеек (выбранных через Ctrl или отфильтрованных). 1. В файле-источнике данных необходимо запускать макрос: [vba]
Код
Sub Copy_ROWs_to_EXT_FILE() ' скопировать строки выделенных ячеек во внешний файл-накопитель '--------------------------------------------------------------------------------------- ' Procedure : Copy_ROWs_to_EXT_FILE ' Author : KuklP & Alex_ST ' Topic_HEADER : Макрос "Copy_ROWs_to_EXT_FILE" ' Topic_URL : http://www.excelworld.ru/forum/3-176-2008-16-1293625247 ' DateTime : 29.12.10, 15:20 ' Purpose : скопировать строки выделенных ячеек во внешний файл-накопитель ' Notes : после работы макроса файл-накопитель становится невидимым в обычных окнах Excel (как надстройка или Personal.xls) '--------------------------------------------------------------------------------------- If Not TypeName(Selection) = "Range" Then Exit Sub Dim lr&, wb As Workbook, lb As Workbook With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With Set wb = GetObject("c:\test.xls") 'путь к файлу-накопителю Set lb = ThisWorkbook lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1) wb.Close (True) ' закрыть с сохранением With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With Set wb = Nothing: Set lb = Nothing End Sub
[/vba]
2. Чтобы после работы макроса файл-накопитель не становился невидимым в окнах Excel (как надстройка или Personal.xls), в нём нужно прописать: [vba]
Код
Private Sub Workbook_Open() If Me.Parent.Caption = Application.Caption Then Windows(Me.Name).Visible = True End Sub
Тут на дружественном форуме выяснилось, что если источник и накопитель лежат у кого-то на компе на расшаренном ресурсе, то с других компов возникают проблемы... KuklP там предложил, а я оформил такую изменённую версию макроса: [vba]
Код
Sub Copy_ROWs_to_EXT_FILE() ' скопировать строки выделенных ячеек во внешний файл-накопитель '--------------------------------------------------------------------------------------- ' Procedure : Copy_ROWs_to_EXT_FILE ' Author : KuklP & Alex_ST ' Topic_HEADER : Макрос "Copy_ROWs_to_EXT_FILE" ' Topic_URL : http://www.excelworld.ru/forum/3-176-2008-16-1293625247 ' DateTime : 29.12.10, 15:20 ' Purpose : скопировать строки выделенных ячеек во внешний файл-накопитель ' Notes : после работы макроса файл-накопитель становится невидимым в обычных окнах Excel (как надстройка или Personal.xls) '--------------------------------------------------------------------------------------- If Not TypeName(Selection) = "Range" Then Exit Sub Dim lr&, wb As Workbook, lb As Workbook With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With On Error Resume Next Set wb = GetObject("c:\test.xls") ' локальный путь к файлу-накопителю If Err Then Err.Clear: Set wb = GetObject("Сетевой путь\test.xls") ' сетевой путь к файлу-накопителю (если нужно) If Err Then MsgBox "Файл test.xls не доступен!": Exit Sub Set lb = ThisWorkbook lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1) ' копирование wb.Close (True) ' закрыть с сохранением With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With Set wb = Nothing: Set lb = Nothing End Sub
[/vba]
Тут на дружественном форуме выяснилось, что если источник и накопитель лежат у кого-то на компе на расшаренном ресурсе, то с других компов возникают проблемы... KuklP там предложил, а я оформил такую изменённую версию макроса: [vba]
Код
Sub Copy_ROWs_to_EXT_FILE() ' скопировать строки выделенных ячеек во внешний файл-накопитель '--------------------------------------------------------------------------------------- ' Procedure : Copy_ROWs_to_EXT_FILE ' Author : KuklP & Alex_ST ' Topic_HEADER : Макрос "Copy_ROWs_to_EXT_FILE" ' Topic_URL : http://www.excelworld.ru/forum/3-176-2008-16-1293625247 ' DateTime : 29.12.10, 15:20 ' Purpose : скопировать строки выделенных ячеек во внешний файл-накопитель ' Notes : после работы макроса файл-накопитель становится невидимым в обычных окнах Excel (как надстройка или Personal.xls) '--------------------------------------------------------------------------------------- If Not TypeName(Selection) = "Range" Then Exit Sub Dim lr&, wb As Workbook, lb As Workbook With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With On Error Resume Next Set wb = GetObject("c:\test.xls") ' локальный путь к файлу-накопителю If Err Then Err.Clear: Set wb = GetObject("Сетевой путь\test.xls") ' сетевой путь к файлу-накопителю (если нужно) If Err Then MsgBox "Файл test.xls не доступен!": Exit Sub Set lb = ThisWorkbook lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1) ' копирование wb.Close (True) ' закрыть с сохранением With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With Set wb = Nothing: Set lb = Nothing End Sub
Доброго времени суток. Alex_ST я немного туговат в использовании VBA, а точнее макросы создаю только в автоматическом ремжиме. У меня стоит задача сохранять однотипные данные из разных книг excel в одной книге накопителе (причем только данные, без формул). По поиску попал на Ваш макрос, мне кажется удачно. Хотелось бы пошагово (для профанов) способ вставки указанного Вами макроса в книгу. P.S. Может подскажете ссылку на решение задачи по учету расходных материалов на производстве по мере выхода готовой продукции. Суть такова: При закупке материалов их надо суммировать к остаткам этих материалов, а при выходе готовой продукции их надо вычитать из имеющегося колличества материала. Учет расходных материалов хотелось бы вести во внешней книге, т.к. на каждую новую партию товара завожу новую книгу. Заранее блалгодарен.
Доброго времени суток. Alex_ST я немного туговат в использовании VBA, а точнее макросы создаю только в автоматическом ремжиме. У меня стоит задача сохранять однотипные данные из разных книг excel в одной книге накопителе (причем только данные, без формул). По поиску попал на Ваш макрос, мне кажется удачно. Хотелось бы пошагово (для профанов) способ вставки указанного Вами макроса в книгу. P.S. Может подскажете ссылку на решение задачи по учету расходных материалов на производстве по мере выхода готовой продукции. Суть такова: При закупке материалов их надо суммировать к остаткам этих материалов, а при выходе готовой продукции их надо вычитать из имеющегося колличества материала. Учет расходных материалов хотелось бы вести во внешней книге, т.к. на каждую новую партию товара завожу новую книгу. Заранее блалгодарен. Letun
Letun, по поводу учёта прихода-расхода-остатка материалов, то вообще-то, ИМХО, для полноценного решения нужны специальные программы типа 1С Бухгалтерии, но вопросы о том, как хотя бы частично для этого приспособить Ёксель поднимаются часто... Вот, например, посмотрите топики Приход, расход, остаток и Учет материалов на дружественной Планете Excel. А решение, где ведётся полный материальный учёт (номер, дата приходной накладной, наименования, цены, количества в накладной, ... , расходные документы: на основании чего , когда, кому, по какой цене поставки, сколько единиц, ... ) - это, наверное, только 1С.
Letun, по поводу учёта прихода-расхода-остатка материалов, то вообще-то, ИМХО, для полноценного решения нужны специальные программы типа 1С Бухгалтерии, но вопросы о том, как хотя бы частично для этого приспособить Ёксель поднимаются часто... Вот, например, посмотрите топики Приход, расход, остаток и Учет материалов на дружественной Планете Excel. А решение, где ведётся полный материальный учёт (номер, дата приходной накладной, наименования, цены, количества в накладной, ... , расходные документы: на основании чего , когда, кому, по какой цене поставки, сколько единиц, ... ) - это, наверное, только 1С.Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Среда, 23.02.2011, 19:53
А по поводу первой части вашего вопроса, так для начала посмотрите раздел FAQ | Макросы (VBA) Общие вопросы дружественного форума. Там подробно расписано как создавать и где сохранять макросы. А я пока, наверное завтра к обеду, чуть "подпилю" макрос Copy_ROWs_to_EXT_FILE так чтобы он работал не только с первым листом книги-источника, а мог удобно располагаться в личной книге макросов Personal.xls
А по поводу первой части вашего вопроса, так для начала посмотрите раздел FAQ | Макросы (VBA) Общие вопросы дружественного форума. Там подробно расписано как создавать и где сохранять макросы. А я пока, наверное завтра к обеду, чуть "подпилю" макрос Copy_ROWs_to_EXT_FILE так чтобы он работал не только с первым листом книги-источника, а мог удобно располагаться в личной книге макросов Personal.xlsAlex_ST
Letun, вот попробуйте доработанный вариант. Теперь макрос может быть размещён где угодно (например, в личной книге макросов), а основной (локальный) и резервный (сетевой) пути к файлу-накопителю указываются не в коде, а в примечаниях к ячейкам А1 и В1 листов файла-источника (адреса ячеек могут быть изменены: в коде VBA они заданы константами sLocDestPath и sNetDestPath) В тексте примечаний пути к файлу-накопителю прописываются ВО ВТОРОЙ СТРОКЕ (после переноса строки)
Letun, вот попробуйте доработанный вариант. Теперь макрос может быть размещён где угодно (например, в личной книге макросов), а основной (локальный) и резервный (сетевой) пути к файлу-накопителю указываются не в коде, а в примечаниях к ячейкам А1 и В1 листов файла-источника (адреса ячеек могут быть изменены: в коде VBA они заданы константами sLocDestPath и sNetDestPath) В тексте примечаний пути к файлу-накопителю прописываются ВО ВТОРОЙ СТРОКЕ (после переноса строки)Alex_ST
Доброго времени суток Alex_ST. Макрос запустил, спасибо. Можно ли его подправить так, что бы копирывались не ссылки на данные, а значения. И новая информация всегда располагалась в верхней строке, а накопленная опускалась в низ. И ещё, что надо убрать из макроса, что бы файл накопитель поле дополнения остался открытым.
Доброго времени суток Alex_ST. Макрос запустил, спасибо. Можно ли его подправить так, что бы копирывались не ссылки на данные, а значения. И новая информация всегда располагалась в верхней строке, а накопленная опускалась в низ. И ещё, что надо убрать из макроса, что бы файл накопитель поле дополнения остался открытым.Letun
Letun, извините, но изменение предлагающегося в качестве "Обмена опытом" макроса под ВАШИ хотелки, ИМХО, выходит за рамки тематики ветки Есть готовое решение Заложенные в него "при рождении" функции макрос выполняет на 100%. Кроме того, как усовершенствование, добавлены возможности работы по сети и задания пути к файлу-накопителю не в коде, а в примечаниях к ячейкам. В коде имеются примечания. Принцип работы показан... Нужно вам вставлять выше первой строки, а не в конец, так включайте макрорекордер, записывайте последовательности команд, необходимых для вставки ЗНАЧЕНИЙ скопированных строк со сдвигом вниз имеющихся... Анализируйте их. Пробуйте сами доработать макрос. А вот уже тогда, если что-то не получится, то создавайте топик с просьбой о помощи и примером с результатами ВАШИХ попыток модернизации макроса "под себя", но не здесь, а в ветке Вопросы по MS Excel. Там я с удовольствием вам помогу.
Letun, извините, но изменение предлагающегося в качестве "Обмена опытом" макроса под ВАШИ хотелки, ИМХО, выходит за рамки тематики ветки Есть готовое решение Заложенные в него "при рождении" функции макрос выполняет на 100%. Кроме того, как усовершенствование, добавлены возможности работы по сети и задания пути к файлу-накопителю не в коде, а в примечаниях к ячейкам. В коде имеются примечания. Принцип работы показан... Нужно вам вставлять выше первой строки, а не в конец, так включайте макрорекордер, записывайте последовательности команд, необходимых для вставки ЗНАЧЕНИЙ скопированных строк со сдвигом вниз имеющихся... Анализируйте их. Пробуйте сами доработать макрос. А вот уже тогда, если что-то не получится, то создавайте топик с просьбой о помощи и примером с результатами ВАШИХ попыток модернизации макроса "под себя", но не здесь, а в ветке Вопросы по MS Excel. Там я с удовольствием вам помогу.Alex_ST
Прошу прощения, возник вопрос : Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1) если вместо этой строчки я напишу: Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 4) то данные из диапазона источника у меня начнут вставляться в накопитель со столбца D ? или же всиравно вставит новую сточку? Дело в том что первые три столбца у меня заняты гораздо дальше и определять последнюю незаполненную ячейку следует именно в столбце D соответственно и записывать из источника тоже
Прошу прощения, возник вопрос : Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1) если вместо этой строчки я напишу: Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 4) то данные из диапазона источника у меня начнут вставляться в накопитель со столбца D ? или же всиравно вставит новую сточку? Дело в том что первые три столбца у меня заняты гораздо дальше и определять последнюю незаполненную ячейку следует именно в столбце D соответственно и записывать из источника тожеГость
1. Ну, взяли бы и попробовали 2. ИМХО, должна вывалиться ошибка, т.к. правые 3 ячейки скопированной строки не влезут в количество столбцов листа. Значит нужно ограничить число столбцов копируемого диапазона. Вам ведь вряд ли нужны данные из всех столбцов копируемых строк? Ну, тогда и копируйте не[vba]
Код
Selection.EntireRow.Copy
[/vba] а, например, если нужны только ячейки из столбцов A...D [vba]
1. Ну, взяли бы и попробовали 2. ИМХО, должна вывалиться ошибка, т.к. правые 3 ячейки скопированной строки не влезут в количество столбцов листа. Значит нужно ограничить число столбцов копируемого диапазона. Вам ведь вряд ли нужны данные из всех столбцов копируемых строк? Ну, тогда и копируйте не[vba]
Код
Selection.EntireRow.Copy
[/vba] а, например, если нужны только ячейки из столбцов A...D [vba]
Здравствуйте. Увидел эту тему так обрадовался...НО При тестировании ПОЛНОЕ РАЗОЧАРОВАНИЕ: (Прилагаю архив с двумя файлами "источником" и "накопителем") В "накопителе" есть все результаты тестов, а также 2 листа, которые ХОТЕЛ получить в результате копирования (которые получаются при ручном
переносе таблиц).
Модуль1 - первый выложенный макрос, где путь надо прописывать внутри
макроса. Модуль2- второй макрос, где путь прописывается в примечаниях А1 ------- Первое копирование Модулем 1 объединенных ячеек прошло успешно, за
исключением того, что вместо "данных с формулой на соседний лист" были
нули. Второе копирование Модулем 1 объединенных ячеек прошло НЕУДАЧНО, вся таблица съехала, причем наехала на предыдущую. ------- Первое копирование Модулем 1 разъединенных ячеек прошло абсолютно также
как и с объединенными (то есть были нули). Второе копирование Модулем 1 разъединенных ячеек прошло абсолютно также
как и с объединенными (то есть последующая таблица наехала на
предыдущую). ------- Копирования Модулем 2 - по результатам ничем не отличается от Модуля 1.
Вывод: Оба Макроса некорректно переносят таблицы - независимо от того есть ли
там объединенные ячейки или нет. Так же не сохраняется результат ячеек, формулы которых ссылаются на
соседний лист (проверял НЕ ОБНОВЛЯЯ СВЯЗИ, И ОБНОВЛЯЯ СВЯЗИ - результат
один и тот же - НУЛИ)
Это возможно как-то исправить? Или данный макрос только для переноса текста?
Здравствуйте. Увидел эту тему так обрадовался...НО При тестировании ПОЛНОЕ РАЗОЧАРОВАНИЕ: (Прилагаю архив с двумя файлами "источником" и "накопителем") В "накопителе" есть все результаты тестов, а также 2 листа, которые ХОТЕЛ получить в результате копирования (которые получаются при ручном
переносе таблиц).
Модуль1 - первый выложенный макрос, где путь надо прописывать внутри
макроса. Модуль2- второй макрос, где путь прописывается в примечаниях А1 ------- Первое копирование Модулем 1 объединенных ячеек прошло успешно, за
исключением того, что вместо "данных с формулой на соседний лист" были
нули. Второе копирование Модулем 1 объединенных ячеек прошло НЕУДАЧНО, вся таблица съехала, причем наехала на предыдущую. ------- Первое копирование Модулем 1 разъединенных ячеек прошло абсолютно также
как и с объединенными (то есть были нули). Второе копирование Модулем 1 разъединенных ячеек прошло абсолютно также
как и с объединенными (то есть последующая таблица наехала на
предыдущую). ------- Копирования Модулем 2 - по результатам ничем не отличается от Модуля 1.
Вывод: Оба Макроса некорректно переносят таблицы - независимо от того есть ли
там объединенные ячейки или нет. Так же не сохраняется результат ячеек, формулы которых ссылаются на
соседний лист (проверял НЕ ОБНОВЛЯЯ СВЯЗИ, И ОБНОВЛЯЯ СВЯЗИ - результат
один и тот же - НУЛИ)
Это возможно как-то исправить? Или данный макрос только для переноса текста?Saandr
Saandr, 1. Оба макроса работают по одному и тому же принципу, полностью аналогичному последовательности действий "ручками": - выделить целиком строку в "источнике" - скопировать эту строку в буфер обмена - вставить из буфера обмена скопированную строку в "накопитель" на лист с самым левым ярлычком ( Sheets(1) ) после последней заполненной строки. Поэтому тестировать перенос данных ими обоими было бессмысленно. 2. В первом же посте топика написано, что при копировании строк, содержащих данные, вычисляемые по формулам, ссылающимся на ячейки в других строках, скорее всего будут ошибки. Что и произошло в Вашем примере. 3. Объединённые ячейки - это ЗЛО, нарушающее регулярную структуру таблиц данных и потому чаще всего вызывающие ошибки при программной обработке, не рассчитанной на эти нарушения. Вы сами попробуйте "в ручную" скопировать данные по одной строке... Будет тот же результат, что и от работы макроса. Ведь в скрытых под объединённой ячейках нули. А то, что макрос может копировать не одну строку (для чего, собственно и писался), а несколько (без объединения ячеек, конечно), то это побочный положительный эффект.
Saandr, 1. Оба макроса работают по одному и тому же принципу, полностью аналогичному последовательности действий "ручками": - выделить целиком строку в "источнике" - скопировать эту строку в буфер обмена - вставить из буфера обмена скопированную строку в "накопитель" на лист с самым левым ярлычком ( Sheets(1) ) после последней заполненной строки. Поэтому тестировать перенос данных ими обоими было бессмысленно. 2. В первом же посте топика написано, что при копировании строк, содержащих данные, вычисляемые по формулам, ссылающимся на ячейки в других строках, скорее всего будут ошибки. Что и произошло в Вашем примере. 3. Объединённые ячейки - это ЗЛО, нарушающее регулярную структуру таблиц данных и потому чаще всего вызывающие ошибки при программной обработке, не рассчитанной на эти нарушения. Вы сами попробуйте "в ручную" скопировать данные по одной строке... Будет тот же результат, что и от работы макроса. Ведь в скрытых под объединённой ячейках нули. А то, что макрос может копировать не одну строку (для чего, собственно и писался), а несколько (без объединения ячеек, конечно), то это побочный положительный эффект.Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Среда, 25.04.2012, 15:51
Даже если откинуть пункты 2 и 3 (про ссылки на другие листы и объединенные ячейки), то пункт 1 делался именно так! 1)- Выделялись строки 4:13 и копировались ручками на лист "(ХУДШЕЕ) что хотелось бы иметь" (БЕЗ ОБЪЕДИНЕННЫХ ЯЧЕЕК) 2)- Выделялись строки 4:13 и копировались ручками на лист "(ЛУЧШЕЕ) что хотелось бы иметь" (С ОБЪЕДИНЕННЫМИ ЯЧЕЙКАМИ) и там и там по несколько раз, чтобы создать длинную таблицу. Так вот при этом ничего нигде не съезжало - все ровненько и как надо. А вот если тоже самое делать с помощью вашего макроса - то результат можно посмотреть на 4 листах Модуль 1...2 Так вот там когда выделяешь и копируешь первый раз (с помощью макроса) - первая таблица получается хорошо. Но если копировать эту же таблицу (с помощью макроса) второй раз - то последняя таблица наезжает на предыдущую независимо НИ ОТ ОБЪЕДИНЕННЫХ ЯЧЕЕК, НИ ОТ ССЫЛОК, НИ ОТ ТОГО ЗАКРЫВАЛИСЬ ФАЙЛЫ ПОСЛЕ КОПИРОВАНИЯ ИЛИ НЕТ. Просто наезжают и все. Посмотрите таблицы.
Даже если откинуть пункты 2 и 3 (про ссылки на другие листы и объединенные ячейки), то пункт 1 делался именно так! 1)- Выделялись строки 4:13 и копировались ручками на лист "(ХУДШЕЕ) что хотелось бы иметь" (БЕЗ ОБЪЕДИНЕННЫХ ЯЧЕЕК) 2)- Выделялись строки 4:13 и копировались ручками на лист "(ЛУЧШЕЕ) что хотелось бы иметь" (С ОБЪЕДИНЕННЫМИ ЯЧЕЙКАМИ) и там и там по несколько раз, чтобы создать длинную таблицу. Так вот при этом ничего нигде не съезжало - все ровненько и как надо. А вот если тоже самое делать с помощью вашего макроса - то результат можно посмотреть на 4 листах Модуль 1...2 Так вот там когда выделяешь и копируешь первый раз (с помощью макроса) - первая таблица получается хорошо. Но если копировать эту же таблицу (с помощью макроса) второй раз - то последняя таблица наезжает на предыдущую независимо НИ ОТ ОБЪЕДИНЕННЫХ ЯЧЕЕК, НИ ОТ ССЫЛОК, НИ ОТ ТОГО ЗАКРЫВАЛИСЬ ФАЙЛЫ ПОСЛЕ КОПИРОВАНИЯ ИЛИ НЕТ. Просто наезжают и все. Посмотрите таблицы.Saandr
Ну, всё понятно теперь. Ведь программа определяет строку, начиная с которой нужно записывать данные, по результату поиска последней заполненной ячейки в столбце А: [vba]
Code
lr = wbkDEST.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
[/vba]а у Вас в копируемых строках в первом столбце полно пустых ячеек получается (я же говорил, что объединёные ячейки - ЗЛО!). Вот новые строки и дописываются после последней, у которой в столбце А пусто, затирая при этом всё, что в других столбцах (имеют полное на это право ) Для Вашего случая нужно либо изменять метод поиска последней строки:[vba]
Code
lr = wbkDEST.Sheets(1).UsedRange.Row + wbkDEST.Sheets(1).UsedRange.Rows.Count - 1
[/vba], либо искать по другому столбцу, например, по D:[vba]
Code
lr = wbkDEST.Sheets(1).Cells(Rows.Count, 4).End(xlUp).Row
[/vba]
Ну, всё понятно теперь. Ведь программа определяет строку, начиная с которой нужно записывать данные, по результату поиска последней заполненной ячейки в столбце А: [vba]
Code
lr = wbkDEST.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
[/vba]а у Вас в копируемых строках в первом столбце полно пустых ячеек получается (я же говорил, что объединёные ячейки - ЗЛО!). Вот новые строки и дописываются после последней, у которой в столбце А пусто, затирая при этом всё, что в других столбцах (имеют полное на это право ) Для Вашего случая нужно либо изменять метод поиска последней строки:[vba]
Code
lr = wbkDEST.Sheets(1).UsedRange.Row + wbkDEST.Sheets(1).UsedRange.Rows.Count - 1
[/vba], либо искать по другому столбцу, например, по D:[vba]
Code
lr = wbkDEST.Sheets(1).Cells(Rows.Count, 4).End(xlUp).Row
lr = wbkDEST.Sheets(1).UsedRange.Row + wbkDEST.Sheets(1).UsedRange.Rows.Count - 1
[/vba] Ваш макрос стал почти универсальным! Вот если бы Вы немножко изменили путь прописывания файла-накопителя - он бы стал по истине
универсальным и УДОБНЫМ! Если вы сделаете 3 возможности прописывания этого пути, то будет просто безумно УДОБНО: 1 путь для постоянного хранения файла-накопителя в одном месте (этот путь легче 1 раз
прописать в макросе и все) (как у Вас было в первом варианте макроса). 2 путь - как у Вас сейчас - через примечания (для тех кто не лазит в макросы) 3 путь - сделать всплывающее окно, предлагающее найти файл-накопитель (это удобно для тех,
у кого и разные файлы источники и разные файлы-накопители) (то есть много разных файлов и
тех и других). Причем очередность лучше сделать именно такой - если есть пункт 1 он исполняется, если его
нет то переход ко второму пункту, если его нет, то к третьему. С уважением, Сергей.
С этой строкой [vba]
Code
lr = wbkDEST.Sheets(1).UsedRange.Row + wbkDEST.Sheets(1).UsedRange.Rows.Count - 1
[/vba] Ваш макрос стал почти универсальным! Вот если бы Вы немножко изменили путь прописывания файла-накопителя - он бы стал по истине
универсальным и УДОБНЫМ! Если вы сделаете 3 возможности прописывания этого пути, то будет просто безумно УДОБНО: 1 путь для постоянного хранения файла-накопителя в одном месте (этот путь легче 1 раз
прописать в макросе и все) (как у Вас было в первом варианте макроса). 2 путь - как у Вас сейчас - через примечания (для тех кто не лазит в макросы) 3 путь - сделать всплывающее окно, предлагающее найти файл-накопитель (это удобно для тех,
у кого и разные файлы источники и разные файлы-накопители) (то есть много разных файлов и
тех и других). Причем очередность лучше сделать именно такой - если есть пункт 1 он исполняется, если его
нет то переход ко второму пункту, если его нет, то к третьему. С уважением, Сергей.Saandr
Сообщение отредактировал Saandr - Четверг, 26.04.2012, 12:15
Зря Вы ругали свой макрос и объединенные ячейки... ЗЛО видите ли...:))) Ваш макрос прекрасно переносит объединенные ячейки (со всеми формулами), а благодаря строке из поста выше - все КОРРЕКТНО объединяется! Проверено - работает!
Зря Вы ругали свой макрос и объединенные ячейки... ЗЛО видите ли...:))) Ваш макрос прекрасно переносит объединенные ячейки (со всеми формулами), а благодаря строке из поста выше - все КОРРЕКТНО объединяется! Проверено - работает!Saandr
Не всё так хорошо. Не с проста изначально в макросе применялся метод определения строки последней заполненной ячейки как[vba]
Code
lr = wbkDEST.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
[/vba]Дело в том, что метод[vba]
Code
lr = wbkDEST.Sheets(1).UsedRange.Row + wbkDEST.Sheets(1).UsedRange.Rows.Count - 1
[/vba] МОЖЕТ СЧИТАТЬ НЕ ВЕРНО после удаления последней ячейки, а также может учесть пустую, но форматированную ячейку (заливка, границы, УФ, …). Этот метод потому редко и применяют, что он правильно работает в только что созданном документе, в котором только добавляются данные в строки/столбцы. Если не хотите большой вероятности проблем, то всё-таки лучше использовать изначальный метод, изменив в нём номер столбца, по которому определяется последняя ячейка, на тот, в котором всегда есть данные в вашей таблице. Это, похоже, столбец D (номер 4). Тогда лучше будет записать так, как я уже предлагал:[vba]
Code
lr = wbkDEST.Sheets(1).Cells(Rows.Count, 4).End(xlUp).Row
[/vba]
Не всё так хорошо. Не с проста изначально в макросе применялся метод определения строки последней заполненной ячейки как[vba]
Code
lr = wbkDEST.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
[/vba]Дело в том, что метод[vba]
Code
lr = wbkDEST.Sheets(1).UsedRange.Row + wbkDEST.Sheets(1).UsedRange.Rows.Count - 1
[/vba] МОЖЕТ СЧИТАТЬ НЕ ВЕРНО после удаления последней ячейки, а также может учесть пустую, но форматированную ячейку (заливка, границы, УФ, …). Этот метод потому редко и применяют, что он правильно работает в только что созданном документе, в котором только добавляются данные в строки/столбцы. Если не хотите большой вероятности проблем, то всё-таки лучше использовать изначальный метод, изменив в нём номер столбца, по которому определяется последняя ячейка, на тот, в котором всегда есть данные в вашей таблице. Это, похоже, столбец D (номер 4). Тогда лучше будет записать так, как я уже предлагал:[vba]
Code
lr = wbkDEST.Sheets(1).Cells(Rows.Count, 4).End(xlUp).Row
А по поводу задания пути к файлу в диалоге, честно говоря, лень возиться. Если Вам нужно, то попробуйте сами. Вот пример получения полного имени файла с комментариями на любой вкус:[vba]
Code
Private Sub test_GetOpenFilename() Dim GetFileName 'GetFileName = Application.GetOpenFilename(FileFilter:="All Files(*.*),*.*", Title:="Выбор файла", MultiSelect:=False) 'GetFileName = Application.GetOpenFilename(FileFilter:="Книга MS Excel-2003 (*.xls),*.xls,Add-In Files (*.xla),*.xla", Title:="Выбор файла", MultiSelect:=False) GetFileName = Application.GetOpenFilename(FileFilter:="Книга MS Excel-2003 (*.xls),*.xls", Title:="Выбор файла", MultiSelect:=False) 'GetFileName = Application.GetOpenFilename(, , "Выбор файла", , False) If VarType(GetFileName) = vbBoolean Then Exit Sub ' если нажали "Отмена", то GetFileName = False 'If TypeName(GetFileName) = "Boolean" Then Exit Sub ' если нажали "Отмена", то GetFileName = False MsgBox GetFileName 'Workbooks.Open GetFileName End Sub
[/vba]
А по поводу задания пути к файлу в диалоге, честно говоря, лень возиться. Если Вам нужно, то попробуйте сами. Вот пример получения полного имени файла с комментариями на любой вкус:[vba]
Code
Private Sub test_GetOpenFilename() Dim GetFileName 'GetFileName = Application.GetOpenFilename(FileFilter:="All Files(*.*),*.*", Title:="Выбор файла", MultiSelect:=False) 'GetFileName = Application.GetOpenFilename(FileFilter:="Книга MS Excel-2003 (*.xls),*.xls,Add-In Files (*.xla),*.xla", Title:="Выбор файла", MultiSelect:=False) GetFileName = Application.GetOpenFilename(FileFilter:="Книга MS Excel-2003 (*.xls),*.xls", Title:="Выбор файла", MultiSelect:=False) 'GetFileName = Application.GetOpenFilename(, , "Выбор файла", , False) If VarType(GetFileName) = vbBoolean Then Exit Sub ' если нажали "Отмена", то GetFileName = False 'If TypeName(GetFileName) = "Boolean" Then Exit Sub ' если нажали "Отмена", то GetFileName = False MsgBox GetFileName 'Workbooks.Open GetFileName End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
) 
