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

Вход

Регистрация

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

 

= Мир MS Excel/Перенос данных между книгами по условию - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Перенос данных между книгами по условию
Daniel Дата: Вторник, 19.08.2014, 01:38 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Вечер добрый,

не сомневаюсь что тема затёртая, но уже 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)

ThisWorkbook.Worksheets("Sheet1").Columns("A:C").Value = _
                 wrkBook.Worksheets("Sheet1").Columns("A:C").Value

wrkBook.Close
Set wrkBook = Nothing

End Sub
[/vba]

Не сомневаюсь что опытным это будет как семечки.. обычно за помощю обращаюсь уже в крайнем случае.. надеюсь поможете ;)

Уже 7 лет работаю с экселем, но макросами увлёкся всего неделю назад, стыд и позор, но так зацепило, что просто с ума сойти, идей немеренно как упростить жизьн себе и коллегам по работе... где я был раньше, слыхал о макросах, но я далек от програмирования и видимо поэтому меня не влекло к этому. Но лучше позже чем никогда :)
К сообщению приложен файл: kniga3.xlsx (9.3 Kb)
 
Ответить
СообщениеВечер добрый,

не сомневаюсь что тема затёртая, но уже 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)

ThisWorkbook.Worksheets("Sheet1").Columns("A:C").Value = _
                 wrkBook.Worksheets("Sheet1").Columns("A:C").Value

wrkBook.Close
Set wrkBook = Nothing

End Sub
[/vba]

Не сомневаюсь что опытным это будет как семечки.. обычно за помощю обращаюсь уже в крайнем случае.. надеюсь поможете ;)

Уже 7 лет работаю с экселем, но макросами увлёкся всего неделю назад, стыд и позор, но так зацепило, что просто с ума сойти, идей немеренно как упростить жизьн себе и коллегам по работе... где я был раньше, слыхал о макросах, но я далек от програмирования и видимо поэтому меня не влекло к этому. Но лучше позже чем никогда :)

Автор - Daniel
Дата добавления - 19.08.2014 в 01:38
Rioran Дата: Вторник, 19.08.2014, 10:04 | Сообщение № 2
Группа: Авторы
Ранг: Ветеран
Сообщений: 903
Репутация: 290 ±
Замечаний: 0% ±

Excel 2013
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.]
К сообщению приложен файл: kniga2.xlsm (21.4 Kb)


Роман, Москва, voronov_rv@mail.ru
Яндекс-Деньги: 41001312674279


Сообщение отредактировал Rioran - Вторник, 19.08.2014, 10:25
 
Ответить
Сообщение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
Дата добавления - 19.08.2014 в 10:04
Daniel Дата: Среда, 20.08.2014, 00:29 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Rioran,

здорово! Огромное спасибо за доработку hands подогнал макрос под рабочий файл

В процессе переноса данных из книги2 в книгу3 данными в книге3 заполнились столбики (А:Т), т.е. 20 столбиков, а остольные 36 столбиков остались пустыми. Возможно сможете подсказать почему? Что нужно бы подправить в макросе, чтобы все столбики на листе были перенесены из одной книги в другую...

[offtop]Ребенок приболел, поэтому временно ток по вечерам могу присесть к компу и поработать...[/offtop]
 
Ответить
СообщениеRioran,

здорово! Огромное спасибо за доработку hands подогнал макрос под рабочий файл

В процессе переноса данных из книги2 в книгу3 данными в книге3 заполнились столбики (А:Т), т.е. 20 столбиков, а остольные 36 столбиков остались пустыми. Возможно сможете подсказать почему? Что нужно бы подправить в макросе, чтобы все столбики на листе были перенесены из одной книги в другую...

[offtop]Ребенок приболел, поэтому временно ток по вечерам могу присесть к компу и поработать...[/offtop]

Автор - Daniel
Дата добавления - 20.08.2014 в 00:29
Rioran Дата: Среда, 20.08.2014, 09:25 | Сообщение № 4
Группа: Авторы
Ранг: Ветеран
Сообщений: 903
Репутация: 290 ±
Замечаний: 0% ±

Excel 2013
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]


Роман, Москва, voronov_rv@mail.ru
Яндекс-Деньги: 41001312674279
 
Ответить
Сообщение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]

Автор - Rioran
Дата добавления - 20.08.2014 в 09:25
_Boroda_ Дата: Среда, 20.08.2014, 09:33 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 16910
Репутация: 6615 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Скорее всего в первой строке таблицы у Вас есть пустая ячейка в столбце U

Для лечения вместо
Do While Cells(1, A + 1).Value <> ""
A = A + 1
Loop

нужно написать [vba]
Код
A = Cells(1, Columns.Count).End(xlToLeft).Column
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
Скорее всего в первой строке таблицы у Вас есть пустая ячейка в столбце U

Для лечения вместо
Do While Cells(1, A + 1).Value <> ""
A = A + 1
Loop

нужно написать [vba]
Код
A = Cells(1, Columns.Count).End(xlToLeft).Column
[/vba]

Автор - _Boroda_
Дата добавления - 20.08.2014 в 09:33
Rioran Дата: Среда, 20.08.2014, 09:39 | Сообщение № 6
Группа: Авторы
Ранг: Ветеран
Сообщений: 903
Репутация: 290 ±
Замечаний: 0% ±

Excel 2013
нужно написать
A = Cells(1, Columns.Count).End(xlToLeft).Column

Подтверждаю, в данном случае это решение лучше.


Роман, Москва, voronov_rv@mail.ru
Яндекс-Деньги: 41001312674279
 
Ответить
Сообщение
нужно написать
A = Cells(1, Columns.Count).End(xlToLeft).Column

Подтверждаю, в данном случае это решение лучше.

Автор - Rioran
Дата добавления - 20.08.2014 в 09:39
Hugo Дата: Среда, 20.08.2014, 09:49 | Сообщение № 7
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3854
Репутация: 814 ±
Замечаний: 0% ±

365
Кстати, эти два подхода могут дать разные результаты в зависимости от файла. И задачи.
Равноценно (по результату) так:
[vba]
Код
    A = Cells(1, 1).End(xlToRight).Column
[/vba]
Про скорость - перебирать ячейки самый долгий путь, берите данные в массив и перебирайте его.
Хотя на таких минимальных объёмах можно не "париться", значимой разницы не будет.


webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD
 
Ответить
СообщениеКстати, эти два подхода могут дать разные результаты в зависимости от файла. И задачи.
Равноценно (по результату) так:
[vba]
Код
    A = Cells(1, 1).End(xlToRight).Column
[/vba]
Про скорость - перебирать ячейки самый долгий путь, берите данные в массив и перебирайте его.
Хотя на таких минимальных объёмах можно не "париться", значимой разницы не будет.

Автор - Hugo
Дата добавления - 20.08.2014 в 09:49
_Boroda_ Дата: Среда, 20.08.2014, 10:20 | Сообщение № 8
Группа: Админы
Ранг: Местный житель
Сообщений: 16910
Репутация: 6615 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
эти два подхода могут дать разные результаты

Естественно.
[vba]
Код
Do While Cells(1, A + 1).Value <> ""
A = A + 1
Loop
[/vba]и[vba]
Код
A = Cells(1, 1).End(xlToRight).Column
[/vba] ищут до первой пустой слева направо, а

[vba]
Код
A = Cells(1, Columns.Count).End(xlToLeft).Column
[/vba] ищет первую заполненную справа налево.
Значения могут совпасть, но вовсе не обязательно


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
эти два подхода могут дать разные результаты

Естественно.
[vba]
Код
Do While Cells(1, A + 1).Value <> ""
A = A + 1
Loop
[/vba]и[vba]
Код
A = Cells(1, 1).End(xlToRight).Column
[/vba] ищут до первой пустой слева направо, а

[vba]
Код
A = Cells(1, Columns.Count).End(xlToLeft).Column
[/vba] ищет первую заполненную справа налево.
Значения могут совпасть, но вовсе не обязательно

Автор - _Boroda_
Дата добавления - 20.08.2014 в 10:20
Daniel Дата: Четверг, 21.08.2014, 11:17 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Rioran, Hugo и Boroda

я ваш должник, надеюсь у вас есть вмр кошелки на случай если мне в будущем понадобится более сложное решение ;)
конечно буду старатся ломать голову самостоятельно, но если вдруг станет совсем печально и бесплатных ресурсов будет нехватать, думаю мы сможем договорится... ;)

сейчас осталось опробовать макрос в полевых условиях, т.е. на работе, но эт ток на след. неделе
отпишусь сюда hands
 
Ответить
СообщениеRioran, Hugo и Boroda

я ваш должник, надеюсь у вас есть вмр кошелки на случай если мне в будущем понадобится более сложное решение ;)
конечно буду старатся ломать голову самостоятельно, но если вдруг станет совсем печально и бесплатных ресурсов будет нехватать, думаю мы сможем договорится... ;)

сейчас осталось опробовать макрос в полевых условиях, т.е. на работе, но эт ток на след. неделе
отпишусь сюда hands

Автор - Daniel
Дата добавления - 21.08.2014 в 11:17
Daniel Дата: Среда, 27.08.2014, 23:09 | Сообщение № 10
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Все работает отлично hands огромное спасибо
 
Ответить
СообщениеВсе работает отлично hands огромное спасибо

Автор - Daniel
Дата добавления - 27.08.2014 в 23:09
  • Страница 1 из 1
  • 1
Поиск:

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