не сомневаюсь что тема затёртая, но уже 5 сутки в поисках доводят до ручки... пересмотрел и перечитал уйму информации, методом многочисленных тыков перебробовал все написанное и решение какбы нашел, все работает почти на ура, но есть одно но... время потраченное на обновление данных.
Суть всего такова:
имеется книга1 с данными и книга2 с кучей формул. Алгоритм придумал простой. Макросом указаным ниже переношу нужные мне столбики из книги1 в книгу2. Все отлично грузится и не так уж и долго (10-15 сек.). Затем другим макросом в книге2 удаляю строки по определенному условию и вот тут начинается проблема. Макрос прогружается ок. 5 мин., а в моем случае это долго. Книгу2 с формулами я хотел положить на сервер, чтоб заинтересованные лица в любой момент могли обновить информацию, но то что удаление по условию проходить "так долго" меня пугает, поэтому решил что нужно создать такую же книгу3 с формулами, а на сервер положить книгу2 но уже без формул и с макросом, который просто загрузить из книги3 нужные столбики но по определенному условию.
Ниже макрос, который в принцыпе работает удовлетворительно перенося данные, проблема в том что я не могу найти как его доработать так чтобы он переносил из прикрепленной к теме книги3 только те строки, в которых в столбике B (Skyriaus ID) есть цыфра 362. Хочу заметить что количество столбиков которое нужно будет перенести - 56, количество строк до 50, если вдруг это чтото меняет...
[vba]
Код
Sub Move() Dim strFileToOpen Dim wrkBook As Workbook strFile = "C:\Users\Aleksandra\Desktop\Test\kniga2.xlsx" Set wrkBook = Workbooks.Open(strFile)
Не сомневаюсь что опытным это будет как семечки.. обычно за помощю обращаюсь уже в крайнем случае.. надеюсь поможете
Уже 7 лет работаю с экселем, но макросами увлёкся всего неделю назад, стыд и позор, но так зацепило, что просто с ума сойти, идей немеренно как упростить жизьн себе и коллегам по работе... где я был раньше, слыхал о макросах, но я далек от програмирования и видимо поэтому меня не влекло к этому. Но лучше позже чем никогда
Вечер добрый,
не сомневаюсь что тема затёртая, но уже 5 сутки в поисках доводят до ручки... пересмотрел и перечитал уйму информации, методом многочисленных тыков перебробовал все написанное и решение какбы нашел, все работает почти на ура, но есть одно но... время потраченное на обновление данных.
Суть всего такова:
имеется книга1 с данными и книга2 с кучей формул. Алгоритм придумал простой. Макросом указаным ниже переношу нужные мне столбики из книги1 в книгу2. Все отлично грузится и не так уж и долго (10-15 сек.). Затем другим макросом в книге2 удаляю строки по определенному условию и вот тут начинается проблема. Макрос прогружается ок. 5 мин., а в моем случае это долго. Книгу2 с формулами я хотел положить на сервер, чтоб заинтересованные лица в любой момент могли обновить информацию, но то что удаление по условию проходить "так долго" меня пугает, поэтому решил что нужно создать такую же книгу3 с формулами, а на сервер положить книгу2 но уже без формул и с макросом, который просто загрузить из книги3 нужные столбики но по определенному условию.
Ниже макрос, который в принцыпе работает удовлетворительно перенося данные, проблема в том что я не могу найти как его доработать так чтобы он переносил из прикрепленной к теме книги3 только те строки, в которых в столбике B (Skyriaus ID) есть цыфра 362. Хочу заметить что количество столбиков которое нужно будет перенести - 56, количество строк до 50, если вдруг это чтото меняет...
[vba]
Код
Sub Move() Dim strFileToOpen Dim wrkBook As Workbook strFile = "C:\Users\Aleksandra\Desktop\Test\kniga2.xlsx" Set wrkBook = Workbooks.Open(strFile)
Не сомневаюсь что опытным это будет как семечки.. обычно за помощю обращаюсь уже в крайнем случае.. надеюсь поможете
Уже 7 лет работаю с экселем, но макросами увлёкся всего неделю назад, стыд и позор, но так зацепило, что просто с ума сойти, идей немеренно как упростить жизьн себе и коллегам по работе... где я был раньше, слыхал о макросах, но я далек от програмирования и видимо поэтому меня не влекло к этому. Но лучше позже чем никогда Daniel
Попробуйте этот макрос вшить в "kniga2". Он открывает книгу3, считает столбцы в ней, проходится по столбцу В и, если в нём видит число 362 - копирует строку в "kniga2". Ссылку поправьте на Ваше расположение. Подсчёт столбцов заканчивается, когда макрос видит первую пустую ячейку в первой строке. Перебор строк заканчивается, когда макрос видит первую пустую ячейку в столбце В.
[vba]
Код
Sub Rio_Move()
Dim wbX As Workbook 'For kniga3 file Dim X As Long 'To roll rows in kniga3 Dim Y As Long 'To roll rows in kniga2 Dim A As Long 'To count columns
'Author: Roman Rioran Voronov 'Date: the 19-th of August, 2014 'Feedback: voronov_rv@mail.ru
'Purpose: Solution for excel-world.ru user ' http://www.excelworld.ru/forum/10-12541-1
Application.ScreenUpdating = 0 Set wbX = Workbooks.Open("C:\Users\rvoronov\Desktop\kniga3.xlsm")
With ThisWorkbook.Worksheets(1) X = 1: Y = 2: A = 1 Do While Cells(1, A + 1).Value <> "" A = A + 1 Loop .Range(.Cells(1, 1), .Cells(1, A)).Value = Range(Cells(1, 1), Cells(1, A)).Value Do While Cells(X, 2).Value <> "" If Cells(X, 2).Value = 362 Then .Range(.Cells(Y, 1), .Cells(Y, A)).Value = Range(Cells(X, 1), Cells(X, A)).Value Y = Y + 1 End If X = X + 1 Loop End With
wbX.Close: Set wbX = Nothing Application.ScreenUpdating = 1
End Sub
[/vba] [p.s.]Кстати, работа над скоростью макросов - одна из актуальных тем. Как показывает практика, зная некоторые приёмы можно ускорять работу программы в тысячи раз. Возможно, уже имеющиеся у Вас коды можно переработать.[/p.s.]
Daniel, здравствуйте.
Попробуйте этот макрос вшить в "kniga2". Он открывает книгу3, считает столбцы в ней, проходится по столбцу В и, если в нём видит число 362 - копирует строку в "kniga2". Ссылку поправьте на Ваше расположение. Подсчёт столбцов заканчивается, когда макрос видит первую пустую ячейку в первой строке. Перебор строк заканчивается, когда макрос видит первую пустую ячейку в столбце В.
[vba]
Код
Sub Rio_Move()
Dim wbX As Workbook 'For kniga3 file Dim X As Long 'To roll rows in kniga3 Dim Y As Long 'To roll rows in kniga2 Dim A As Long 'To count columns
'Author: Roman Rioran Voronov 'Date: the 19-th of August, 2014 'Feedback: voronov_rv@mail.ru
'Purpose: Solution for excel-world.ru user ' http://www.excelworld.ru/forum/10-12541-1
Application.ScreenUpdating = 0 Set wbX = Workbooks.Open("C:\Users\rvoronov\Desktop\kniga3.xlsm")
With ThisWorkbook.Worksheets(1) X = 1: Y = 2: A = 1 Do While Cells(1, A + 1).Value <> "" A = A + 1 Loop .Range(.Cells(1, 1), .Cells(1, A)).Value = Range(Cells(1, 1), Cells(1, A)).Value Do While Cells(X, 2).Value <> "" If Cells(X, 2).Value = 362 Then .Range(.Cells(Y, 1), .Cells(Y, A)).Value = Range(Cells(X, 1), Cells(X, A)).Value Y = Y + 1 End If X = X + 1 Loop End With
wbX.Close: Set wbX = Nothing Application.ScreenUpdating = 1
End Sub
[/vba] [p.s.]Кстати, работа над скоростью макросов - одна из актуальных тем. Как показывает практика, зная некоторые приёмы можно ускорять работу программы в тысячи раз. Возможно, уже имеющиеся у Вас коды можно переработать.[/p.s.]Rioran
здорово! Огромное спасибо за доработку подогнал макрос под рабочий файл
В процессе переноса данных из книги2 в книгу3 данными в книге3 заполнились столбики (А:Т), т.е. 20 столбиков, а остольные 36 столбиков остались пустыми. Возможно сможете подсказать почему? Что нужно бы подправить в макросе, чтобы все столбики на листе были перенесены из одной книги в другую...
[offtop]Ребенок приболел, поэтому временно ток по вечерам могу присесть к компу и поработать...[/offtop]
Rioran,
здорово! Огромное спасибо за доработку подогнал макрос под рабочий файл
В процессе переноса данных из книги2 в книгу3 данными в книге3 заполнились столбики (А:Т), т.е. 20 столбиков, а остольные 36 столбиков остались пустыми. Возможно сможете подсказать почему? Что нужно бы подправить в макросе, чтобы все столбики на листе были перенесены из одной книги в другую...
[offtop]Ребенок приболел, поэтому временно ток по вечерам могу присесть к компу и поработать...[/offtop]Daniel
Daniel, не видя файла, откуда тянутся данные, трудно сказать (*пронзительный такой взгляд с намёком*). Скорее всего в первой строке таблицы у Вас есть пустая ячейка в столбце U. Проверьте первую строку и заполните ячейки хоть единичками.
Топорный вариант в лоб. Если Вам нужно ровно 36 столбцов всегда копировать, то замените в макросе:
[vba]
Код
X = 1: Y = 2: A = 1 Do While Cells(1, A + 1).Value <> "" A = A + 1 Loop
[/vba] На это:
[vba]
Код
X = 1: Y = 2: A = 36
[/vba]
Daniel, не видя файла, откуда тянутся данные, трудно сказать (*пронзительный такой взгляд с намёком*). Скорее всего в первой строке таблицы у Вас есть пустая ячейка в столбце U. Проверьте первую строку и заполните ячейки хоть единичками.
Топорный вариант в лоб. Если Вам нужно ровно 36 столбцов всегда копировать, то замените в макросе:
[vba]
Код
X = 1: Y = 2: A = 1 Do While Cells(1, A + 1).Value <> "" A = A + 1 Loop
Кстати, эти два подхода могут дать разные результаты в зависимости от файла. И задачи. Равноценно (по результату) так: [vba]
Код
A = Cells(1, 1).End(xlToRight).Column
[/vba] Про скорость - перебирать ячейки самый долгий путь, берите данные в массив и перебирайте его. Хотя на таких минимальных объёмах можно не "париться", значимой разницы не будет.
Кстати, эти два подхода могут дать разные результаты в зависимости от файла. И задачи. Равноценно (по результату) так: [vba]
Код
A = Cells(1, 1).End(xlToRight).Column
[/vba] Про скорость - перебирать ячейки самый долгий путь, берите данные в массив и перебирайте его. Хотя на таких минимальных объёмах можно не "париться", значимой разницы не будет.Hugo
я ваш должник, надеюсь у вас есть вмр кошелки на случай если мне в будущем понадобится более сложное решение конечно буду старатся ломать голову самостоятельно, но если вдруг станет совсем печально и бесплатных ресурсов будет нехватать, думаю мы сможем договорится...
сейчас осталось опробовать макрос в полевых условиях, т.е. на работе, но эт ток на след. неделе отпишусь сюда
Rioran, Hugo и Boroda
я ваш должник, надеюсь у вас есть вмр кошелки на случай если мне в будущем понадобится более сложное решение конечно буду старатся ломать голову самостоятельно, но если вдруг станет совсем печально и бесплатных ресурсов будет нехватать, думаю мы сможем договорится...
сейчас осталось опробовать макрос в полевых условиях, т.е. на работе, но эт ток на след. неделе отпишусь сюда Daniel