Страницы: 1
RSS
Корректировка ссылок на файл в расширенном фильтре через VBA
 
Добрый день!
У меня возникла необходимость выцепить необходимые данные из таблицы методом расширенного фильтра.
Исходные данные хранятся в одном файле, а готовые данные после обработки расширенным фильтром в другом.

Мой код выглядит следующим образом:
Код
    ActiveWorkbook.RemovePersonalInformation = 0
    ActiveWorkbook.Worksheets("Ссылки").Activate
    NewFilePath1 = Range("F9").value ' в этой ячейке ссылка на файл с исходными данными
    
    On Error Resume Next
    Workbooks.Open filename:= _
        NewFilePath1, UpdateLinks:=False
    On Error GoTo 0
    
    Windows("Финальный файл.xlsm").Activate
    Sheets("ИТОГО").Select
    Range("I2").Select
    
    Workbooks("Исходный файл.xls").Sheets("Sheet1").Range( _
        "A5:G30358").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "A2:G6"), CopyToRange:=Range("I2:O2"), Unique:=False
Я бы хотел заменить код по расширенному фильтру примерно на следующий:
Код
    Workbooks(Dir(NewFilePath1)).Worksheets(1).Range( _
        "A5:G & Cells(Rows.Count, 1).End(xlUp).Row)").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "A2:G6"), CopyToRange:=Range("I2:O2"), Unique:=False
Т.е. я не хочу привязываться к названию исходного файла в самом коде, можно ли его обозначить в виде переменной в расширенном фильтре, как и порядковый номер листа и исходный диапазон?

Мне выдает ошибку "application defined or object defined error 1004"

Что я делаю не так?

Спасибо.
 
Правильно выдает. Вот это не так:
Код
("A5:G & Cells(Rows.Count, 1).End(xlUp).Row)"

Надо как минимум:
Код
("A5:G" & Cells(Rows.Count, 1).End(xlUp).Row)

Молчу уж о селектах и активациях.
Я сам - дурнее всякого примера! ...
 
kuklp,спасибо, заработало, но только в той же книге.
В другую книгу данные не добавляет, ничего не происходит после обработки кода...
 
stevie44, и не заработает. AdvancedFilter умеет копировать только на тот же лист. Поэтому копируйте все данные, фильтруйте и удаляйте лишнее, только так. Как это сделать, посмотрите тут
 
StoTisteg,это не так, если я запускаю расширенный фильтр в книге, где должны быть финальные данные, а указываю путь на исходную книгу с исходными данными, то все работает.

Т.е. вот эта часть кода рабочая:
Код
    Windows("Финальный файл.xlsm").Activate
    Sheets("ИТОГО").Select
    Range("I2").Select
     
    Workbooks("Исходный файл.xls").Sheets("Sheet1").Range( _
        "A5:G30358").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "A2:G6"), CopyToRange:=Range("I2:O2"), Unique:=False
Я запускаю расширенный фильтр в финальном файле, где должен быть результат, а ссылаюсь на исходные данные в другую книгу.
К примеру, об этом также написано здесь
Изменено: stevie44 - 06.09.2018 11:33:31
 
Цитата
stevie44 написал:
вот эта часть кода рабочая
а что тогда не работает?
Что вообще в переменной NewFilePath1? Что при этом возвращает Dir?  
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков, Workbooks(Dir(NewFilePath1)) - ссылка на книгу с исходными данными. Т.е. я открываю расширенный фильтр в книге, где будут финальные данные, и хочу путем переменных обратиться к исходным данным. Если я это делаю без переменных, то все прекрасно работает. А с переменными после комментария kuklp ошибка пропала, которая была ранее, но в финальную книгу данные не подтягиваются расширенным фильтром, только в исходной.
Изменено: stevie44 - 06.09.2018 11:42:10
 
stevie44, для начала перед Workbooks(Dir(NewFilePath1)) впишите строчку
Код
Buff=Dir(NewFilePath1)
и в F8 посмотрите, какое значение примет Buff...
Изменено: StoTisteg - 06.09.2018 11:46:48
 
StoTisteg, никакой... Код якобы выполняет какое-то действие через расширенный фильтр, но ничего не происходит.
 
Цитата
stevie44 написал:
никакой
Вывод? ВЫ обращаетесь к НИКАКОЙ книге. Вот Вам и ошибка. Ищите проблему к указанному пути.
И лучше выложить больше код - где и как создается эта самая NewFilePath1. Вдруг в ней то, что не может быть корректным путем к файлу.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков, NewFilePath1 наводит меня на мысль, что книгу создали, путь для её сохранения прописали, а вот сохранить её туда забыли...
 
Согласен. Но я пытаюсь донести это до автора темы. Потому что тот кусок, который нам приведен в качестве нерабочего нерабочий как раз только в этой части. А почему именно - без остального кода не понять.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков,весь код указан в 1-м посте, и он успешно работает.
А вот если последнюю часть кода менять на переменные вместо названия файла, то код не срабатывает.
StoTisteg, NewFilePath1 - путь верно указан, файл сохранен, код в 1-м посте работает, там тоже указана данная переменная...
 
Цитата
stevie44 написал:
путь верно указан, файл сохранен
Это не так, раз Dir ничего не возвращает.
 
StoTisteg, это так. Если я прописываю отдельно, не в расширенном фильтре:
Код
Workbooks(Dir(NewFilePath1)).Worksheets(1).Activate
Все срабатывает, а не срабатывает, если прописываю в AdvancedFilter...

Протестировав только что, проблема не в NewFilePath1.

Если я прописываю вот так, то все работает:
Код
     Workbooks(Dir(NewFilePath1)).Worksheets(1).Range( _
        "A5:G30358").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "A2:G6"), CopyToRange:=Range("I2:O2"), Unique:=False
А вот если указываю диапазон:
Код
Workbooks(Dir(NewFilePath1)).Worksheets(1).Range( _
        "A5:G" & Cells(Rows.Count, 1).End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "A2:G6"), CopyToRange:=Range("I2:O2"), Unique:=False
Ошибка где-то тут: A5:G" & Cells(Rows.Count, 1).End(xlUp).Row)
Изменено: stevie44 - 10.09.2018 13:10:09
 
Естественно, здесь ошибка. Вы ищете на листе Workbooks(Dir(NewFilePath1)).Worksheets(1) ячейку с активного листа.
Код
With Workbooks(Dir(NewFilePath1)).Worksheets(1)
.Range(.Cells(5,1),.Cells(.Cells(Rows.Count, 1).End(xlUp).Row,7)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(Cells(2,1),Cells(6,7)), CopyToRange:=Cells(2,9)
End With
 
StoTisteg, я на листе Workbooks(Dir(NewFilePath1)).Worksheets(1) указываю только исходный диапазон, из которого я выцепляю необходимые данные.
Используя указанный Вами код, также выдает ошибку: "application defined or object defined error 1004"
 
stevie44, правильно. Потому что я Вам сразу написал:
Цитата
StoTisteg написал:
AdvancedFilter умеет копировать только на тот же лист.
Попробуйте проделать это ручками и прочитаете то же самое от Экселя.
 
StoTisteg, я в 5-м посте же писал, что можно на другой лист и в другую книгу копировать, об этом также сказано здесь
Ручками я проделал это, код в 1-м посте. Макрорекодером все прекрасно работает, дело не в переменных, не в сохранении на тот же лист, дело в правильности указания диапазона A5:G, именно тут загвоздка...
Изменено: stevie44 - 10.09.2018 15:16:00
 
Вы уверены, что внимательно прочитали то, что там написано? Во-первых, активным должен быть лист с результатами. У Вас так и есть. Во-вторых, CriteriaRange тоже должен находиться на листе с исходными данными. А у Вас он где?
 
StoTisteg, макрорекодером прекрасно работает, при этом CriteriaRange находится на листе с финальными, а не исходными данными. Можете протестировать в любом из файлов, макрорекодером, все работает
 
Цитата
stevie44 написал:
выдает ошибку: "application defined or object defined error 1004"
На какой строке, кстати?
 
StoTisteg,
.Range(.Cells(5,1),.Cells(.Cells(Rows.Count, 1).End(xlUp).Row,7)).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range(Cells(2,1),Cells(6,7)), CopyToRange:=Cells(2,9)
 
Еще точку надо на всякий случай:
.Range(.Cells(5,1),.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row,7)).AdvancedFilter
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков, вообще-то Rows.Count — это константа, от листа не зависящая (впрочем, не мне Вам рассказывать :)), но чем чёрт не шутит...
Изменено: StoTisteg - 10.09.2018 16:34:24
 
Дмитрий(The_Prist) Щербаков, эврика!!!! Заработало!) Точки не хватило)

StoTisteg, Дмитрий(The_Prist) Щербаков, спасибо вам огромное!
Очень помогли!)
Страницы: 1
Наверх