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

Вход

Регистрация

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

 

= Мир MS Excel/Копирование из одной книги в другую с учетом фильтра (VBA) - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование из одной книги в другую с учетом фильтра (VBA) (Макросы/Sub)
Копирование из одной книги в другую с учетом фильтра (VBA)
Romario Дата: Суббота, 11.09.2021, 01:06 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

2013
Всем доброго времени суток! Давно уже бьюсь над задачей копирования данных из одной книги эксель в другую, НО не просто копирование, а копирование с учетом фильтра (условия) в одном из столбцов (фильтр должен быть в файле откуда копируются данные).
У нас с работы просто уволился коллега, который отлично шарил в макросах, но писал довольно непростые коды (особенно для понимания новичка..., я пару недель назад только с нуля вот стал вникать во все эти дебри) и вот собственно некоторые его коды удалось мне переварить так сказать и использовать в работе, но вот в одном из кодов наступил конкретный ступор....

Добрые и умные люди, можете, пожалуйста, подсказать где и какие правки нужно внести в код?
Заранее благодарю!

Макрос:

[vba]
Код
Sub Подгрузка_Кред_проц_ЮЛ_ПОС()

Dim wbImportFile As Workbook
Dim t_

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveWorkbook.ActiveSheet.DisplayPageBreaks = False

ChDrive Left(ThisWorkbook.Path, 1)
ChDir ThisWorkbook.Path & "\"

Имяфайла = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", 1, "Выберите файл 115_099_DD.MM.YY", , False)
If VarType(Имяфайла) = vbBoolean Then Exit Sub

Set wbImportFile = Workbooks.Open(Имяфайла)
t_ = Timer

'лист в рабочем файле-макросе
Set ws = ThisWorkbook.Worksheets("Кред. проц. ЮЛ ПОС")

'лист в файле-доноре, из которого копируется информация
Set ws1 = wbImportFile.Worksheets("Кред. проц. ЮЛ ПОС")

kol_str = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
start_row1 = ws1.Columns("A:A").Find(What:="Портфель", After:=ws1.Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row + 1

For i = start_row1 To kol_str

'Не получается у меня правильно поставить фильтр / условие в 12-ой графе (графа L в файле-доноре),   
'чтобы в этой графе фильтровалось значение «Основной долг» и далее копировалась бы информация в рабочий файл с учетом этого фильтра.   
'В разные места это условие пытался ставить – бестолку, на фильтр реакции либо не было,
'либо копировался всё равно весь массив данных или вообще ничего не копировалось.  
'Пробовал вносить всякие правки и корректировки в разные строки кода – в итоге макрос писал Debug постоянно….уже не знаю что делать…  
'Знаю что можно диапазоном просто тупо скопировать, но дело в том что в этом файле,
'откуда копируется информация, в нём постоянно разное количество строк, то 10 000 то 12 000 и т.д..
'Не хочется копировать диапазон сразу 50 000 или 100 000 строк, с кучей пустых строк внизу...

'вот начиная с этой строчки начинаются сложности....не срабатывает...
'без этой строчки макрос работает, просто берёт сразу весь массив данных, а мне весь массив не нужен...
If Cells(i, 12).Value = "Основной долг" Then

start_row = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(start_row, 1) = ws1.Cells(i, 1)
ws.Cells(start_row, 2) = ws1.Cells(i, 2)
ws.Cells(start_row, 3) = ws1.Cells(i, 3)
ws.Cells(start_row, 4) = ws1.Cells(i, 4)
ws.Cells(start_row, 5) = ws1.Cells(i, 5)
ws.Cells(start_row, 6) = ws1.Cells(i, 6)
ws.Cells(start_row, 7) = ws1.Cells(i, 7)
ws.Cells(start_row, 8) = ws1.Cells(i, 8)
ws.Cells(start_row, 9) = ws1.Cells(i, 9)
ws.Cells(start_row, 10) = ws1.Cells(i, 10)
ws.Cells(start_row, 11) = ws1.Cells(i, 11)
ws.Cells(start_row, 12) = ws1.Cells(i, 12)
ws.Cells(start_row, 13) = ws1.Cells(i, 13)
ws.Cells(start_row, 14) = ws1.Cells(i, 14)
ws.Cells(start_row, 15) = ws1.Cells(i, 15)
ws.Cells(start_row, 16) = ws1.Cells(i, 16)
ws.Cells(start_row, 17) = ws1.Cells(i, 17)
ws.Cells(start_row, 18) = ws1.Cells(i, 18)
ws.Cells(start_row, 19) = ws1.Cells(i, 19)
ws.Cells(start_row, 20) = ws1.Cells(i, 20)
ws.Cells(start_row, 21) = ws1.Cells(i, 21)
ws.Cells(start_row, 22) = ws1.Cells(i, 22)
ws.Cells(start_row, 23) = ws1.Cells(i, 23)
ws.Cells(start_row, 24) = ws1.Cells(i, 24)
ws.Cells(start_row, 25) = ws1.Cells(i, 25)
ws.Cells(start_row, 26) = ws1.Cells(i, 26)
ws.Cells(start_row, 27) = ws1.Cells(i, 27)
ws.Cells(start_row, 28) = ws1.Cells(i, 28)
ws.Cells(start_row, 29) = ws1.Cells(i, 29)
ws.Cells(start_row, 30) = ws1.Cells(i, 30)
ws.Cells(start_row, 31) = ws1.Cells(i, 31)
ws.Cells(start_row, 32) = ws1.Cells(i, 32)
ws.Cells(start_row, 33) = ws1.Cells(i, 33)
ws.Cells(start_row, 34) = ws1.Cells(i, 34)
ws.Cells(start_row, 35) = ws1.Cells(i, 35)

End If
Next i
wbImportFile.Close (False)

Application.ScreenUpdating = True
Application.EnableEvents = True

MsgBox "Данные подгружены! Время: " & Format((Timer - t_), "0") & " сек.", vbOKOnly

End Sub
[/vba]

Сам файл эксель, в котором написан макрос приложить не могу, т.к. там конфиденциальная инфо, в общем ничего за пределы банка выслать, вынести не могу) уволят нафиг)


Сообщение отредактировал Romario - Суббота, 11.09.2021, 01:10
 
Ответить
СообщениеВсем доброго времени суток! Давно уже бьюсь над задачей копирования данных из одной книги эксель в другую, НО не просто копирование, а копирование с учетом фильтра (условия) в одном из столбцов (фильтр должен быть в файле откуда копируются данные).
У нас с работы просто уволился коллега, который отлично шарил в макросах, но писал довольно непростые коды (особенно для понимания новичка..., я пару недель назад только с нуля вот стал вникать во все эти дебри) и вот собственно некоторые его коды удалось мне переварить так сказать и использовать в работе, но вот в одном из кодов наступил конкретный ступор....

Добрые и умные люди, можете, пожалуйста, подсказать где и какие правки нужно внести в код?
Заранее благодарю!

Макрос:

[vba]
Код
Sub Подгрузка_Кред_проц_ЮЛ_ПОС()

Dim wbImportFile As Workbook
Dim t_

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveWorkbook.ActiveSheet.DisplayPageBreaks = False

ChDrive Left(ThisWorkbook.Path, 1)
ChDir ThisWorkbook.Path & "\"

Имяфайла = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", 1, "Выберите файл 115_099_DD.MM.YY", , False)
If VarType(Имяфайла) = vbBoolean Then Exit Sub

Set wbImportFile = Workbooks.Open(Имяфайла)
t_ = Timer

'лист в рабочем файле-макросе
Set ws = ThisWorkbook.Worksheets("Кред. проц. ЮЛ ПОС")

'лист в файле-доноре, из которого копируется информация
Set ws1 = wbImportFile.Worksheets("Кред. проц. ЮЛ ПОС")

kol_str = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
start_row1 = ws1.Columns("A:A").Find(What:="Портфель", After:=ws1.Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row + 1

For i = start_row1 To kol_str

'Не получается у меня правильно поставить фильтр / условие в 12-ой графе (графа L в файле-доноре),   
'чтобы в этой графе фильтровалось значение «Основной долг» и далее копировалась бы информация в рабочий файл с учетом этого фильтра.   
'В разные места это условие пытался ставить – бестолку, на фильтр реакции либо не было,
'либо копировался всё равно весь массив данных или вообще ничего не копировалось.  
'Пробовал вносить всякие правки и корректировки в разные строки кода – в итоге макрос писал Debug постоянно….уже не знаю что делать…  
'Знаю что можно диапазоном просто тупо скопировать, но дело в том что в этом файле,
'откуда копируется информация, в нём постоянно разное количество строк, то 10 000 то 12 000 и т.д..
'Не хочется копировать диапазон сразу 50 000 или 100 000 строк, с кучей пустых строк внизу...

'вот начиная с этой строчки начинаются сложности....не срабатывает...
'без этой строчки макрос работает, просто берёт сразу весь массив данных, а мне весь массив не нужен...
If Cells(i, 12).Value = "Основной долг" Then

start_row = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(start_row, 1) = ws1.Cells(i, 1)
ws.Cells(start_row, 2) = ws1.Cells(i, 2)
ws.Cells(start_row, 3) = ws1.Cells(i, 3)
ws.Cells(start_row, 4) = ws1.Cells(i, 4)
ws.Cells(start_row, 5) = ws1.Cells(i, 5)
ws.Cells(start_row, 6) = ws1.Cells(i, 6)
ws.Cells(start_row, 7) = ws1.Cells(i, 7)
ws.Cells(start_row, 8) = ws1.Cells(i, 8)
ws.Cells(start_row, 9) = ws1.Cells(i, 9)
ws.Cells(start_row, 10) = ws1.Cells(i, 10)
ws.Cells(start_row, 11) = ws1.Cells(i, 11)
ws.Cells(start_row, 12) = ws1.Cells(i, 12)
ws.Cells(start_row, 13) = ws1.Cells(i, 13)
ws.Cells(start_row, 14) = ws1.Cells(i, 14)
ws.Cells(start_row, 15) = ws1.Cells(i, 15)
ws.Cells(start_row, 16) = ws1.Cells(i, 16)
ws.Cells(start_row, 17) = ws1.Cells(i, 17)
ws.Cells(start_row, 18) = ws1.Cells(i, 18)
ws.Cells(start_row, 19) = ws1.Cells(i, 19)
ws.Cells(start_row, 20) = ws1.Cells(i, 20)
ws.Cells(start_row, 21) = ws1.Cells(i, 21)
ws.Cells(start_row, 22) = ws1.Cells(i, 22)
ws.Cells(start_row, 23) = ws1.Cells(i, 23)
ws.Cells(start_row, 24) = ws1.Cells(i, 24)
ws.Cells(start_row, 25) = ws1.Cells(i, 25)
ws.Cells(start_row, 26) = ws1.Cells(i, 26)
ws.Cells(start_row, 27) = ws1.Cells(i, 27)
ws.Cells(start_row, 28) = ws1.Cells(i, 28)
ws.Cells(start_row, 29) = ws1.Cells(i, 29)
ws.Cells(start_row, 30) = ws1.Cells(i, 30)
ws.Cells(start_row, 31) = ws1.Cells(i, 31)
ws.Cells(start_row, 32) = ws1.Cells(i, 32)
ws.Cells(start_row, 33) = ws1.Cells(i, 33)
ws.Cells(start_row, 34) = ws1.Cells(i, 34)
ws.Cells(start_row, 35) = ws1.Cells(i, 35)

End If
Next i
wbImportFile.Close (False)

Application.ScreenUpdating = True
Application.EnableEvents = True

MsgBox "Данные подгружены! Время: " & Format((Timer - t_), "0") & " сек.", vbOKOnly

End Sub
[/vba]

Сам файл эксель, в котором написан макрос приложить не могу, т.к. там конфиденциальная инфо, в общем ничего за пределы банка выслать, вынести не могу) уволят нафиг)

Автор - Romario
Дата добавления - 11.09.2021 в 01:06
Romario Дата: Суббота, 11.09.2021, 01:59 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

2013
Вопрос решён (на другом форуме подсказали)! Извините за беспокойство.
 
Ответить
СообщениеВопрос решён (на другом форуме подсказали)! Извините за беспокойство.

Автор - Romario
Дата добавления - 11.09.2021 в 01:59
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование из одной книги в другую с учетом фильтра (VBA) (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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