Поиск № заказа макросом

Пользователь

Сообщений: 147 Регистрация: 13.06.2013

19.11.2015 09:27:08

Добрый день. Имеется пример, с помощью которого производится выборка и вставка значений из выбранной папки по всем файлам, содержащимся в папке. Как реализовать на этом же примере поиск по номеру заказа, и следовательно выборку и вставку значений только из этого файла. Более подробно описано в примере.

Прикрепленные файлы

пример_ 01.xlsm (20.05 КБ)

Hugo Пользователь Сообщений: 23795 Регистрация: 22.12.2012	#2 19.11.2015 09:56:03 Проверяйте переменную file на наличие своего номера. Изменено: Hugo - 19.11.2015 09:58:34

alexdes Пользователь Сообщений: 147 Регистрация: 13.06.2013	#3 19.11.2015 10:08:44 Вот это и не могу понять как сделать.

Kuzmich

Пользователь

Сообщений: 8043 Регистрация: 21.12.2012

19.11.2015 10:57:33

Код
If Left(file,4)="5256" Then

alexdes Пользователь Сообщений: 147 Регистрация: 13.06.2013	#5 19.11.2015 12:25:42 не помогло, виснет.

CAHO

Пользователь

Сообщений: 2184 Регистрация: 25.02.2013

19.11.2015 12:51:19

Я не знаю что у Вас там не выходит. Но прошлый год я делал для развлечения программку по поиску файлов. Может поможет и вам.

Прикрепленные файлы

Глобальный Поиск файлов в подкаталогах.zip (28.89 КБ)

Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.

alexdes Пользователь Сообщений: 147 Регистрация: 13.06.2013	#7 19.11.2015 12:58:28 спасибо, хороший поиск, но мне еще вычленять значения надо макросом. Изменено: alexdes - 19.11.2015 13:05:32

JayBhagavan

Пользователь

Сообщений: 11833 Регистрация: 17.01.2014

ПОЛ: МУЖСКОЙ | Win10x64, MSO2019x64

19.11.2015 13:05:23

Скрытый текст

Код

Sub Кнопка1_Найти_Добавить()
Dim path As String, file As String, arg As String, i As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Укажите рабочую папку": .Show
        If .SelectedItems.Count = 0 Then
            Exit Sub
        Else
            path = .SelectedItems(1) & "\"
        End If
    End With

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Rows("9:" & Rows.Count).ClearContents: file = Dir(path & "*.xlsm"): i = 9
    Do While file <> ""
        If Left(file, 4) = ActiveSheet.Range("A2").Value Then
            Cells(i, 1) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("D1").Range("A1").Address(, , xlR1C1)) '№ заказа
            Cells(i, 3) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("A4").Range("A1").Address(, , xlR1C1)) 'материал
            Cells(i, 4) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("B4").Range("A1").Address(, , xlR1C1)) 'наименование
            Cells(i, 5) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("C4").Range("A1").Address(, , xlR1C1)) 'оборудование
            Cells(i, 7) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("D4").Range("A1").Address(, , xlR1C1)) 'параметр1
            Cells(i, 8) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("E4").Range("A1").Address(, , xlR1C1)) 'параметр2
            Cells(i, 9) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("F4").Range("A1").Address(, , xlR1C1)) 'кол-во
            Cells(i, 10) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("K4").Range("A1").Address(, , xlR1C1)) 'упаковка
            i = i + 1
        End If: file = Dir
    Loop
    Application.EnableEvents = True
End Sub

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori

alexdes Пользователь Сообщений: 147 Регистрация: 13.06.2013	#9 19.11.2015 13:16:43 выборку значений не делает, т.е. макрос вроде как выполнился, а результата в ячейках нет.

Hugo Пользователь Сообщений: 23795 Регистрация: 22.12.2012	#10 19.11.2015 13:20:39 Ну значит нет таких файлов.

JayBhagavan Пользователь Сообщений: 11833 Регистрация: 17.01.2014 ПОЛ: МУЖСКОЙ \| Win10x64, MSO2019x64	#11 19.11.2015 13:33:27 Или в этих файлах значения пустые. Проверяйте куда ссылаются Ваши диапазоны. Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori

alexdes Пользователь Сообщений: 147 Регистрация: 13.06.2013	#12 19.11.2015 14:00:24 Спасибо, буду дальше разбираться.

Kuzmich

Пользователь

Сообщений: 8043 Регистрация: 21.12.2012

#13

19.11.2015 14:36:03

Запустите макрос в пошаговом режиме и посмотрите, выполняется ли условие

Код
If Left(file, 4) = ActiveSheet.Range("A2").Value Then

Hugo

Пользователь

Сообщений: 23795 Регистрация: 22.12.2012

#14

19.11.2015 14:46:15

Первым делом глянуть глазом что там за файлы.
Если похожи - то посмотреть нет ли впереди пробелов, учесть в коде (например навесить trim).
Ну и может быть нужно навесить и на Range("A2") - мало ли что там...

Изменено: Hugo - 19.11.2015 14:46:35

alexdes

Пользователь

Сообщений: 147 Регистрация: 13.06.2013

#15

19.11.2015 14:57:42

проверил в пошаговом, работает, но не может походу найти файл, хотя файл в папке есть, и имя корректное. Искомый файл всегда сначала содержит 4 цыфры, затем пробел и текст. Получается данные из A2 не может найти в имени файла.(

Изменено: alexdes - 19.11.2015 15:03:26

JayBhagavan Пользователь Сообщений: 11833 Регистрация: 17.01.2014 ПОЛ: МУЖСКОЙ \| Win10x64, MSO2019x64	#16 19.11.2015 14:59:10 alexdes, имя файла сюда скиньте. (я создал файл с указанным в примере именем, где вначале шло "5256" - макрос его нашёл) Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori

alexdes Пользователь Сообщений: 147 Регистрация: 13.06.2013	#17 19.11.2015 15:12:30 вот этот файл "5256" ищем и из него вытаскиваем значения в пример. Не грузятся. Прикрепленные файлы 5256 Наш город № 16.xlsm (8.42 КБ) пример_ 01_2.xlsm (20 КБ) Изменено: alexdes - 19.11.2015 15:18:48

JayBhagavan

Пользователь

Сообщений: 11833 Регистрация: 17.01.2014

ПОЛ: МУЖСКОЙ | Win10x64, MSO2019x64

#18

19.11.2015 15:20:30

Код
If Left(file, 4) = CStr(ActiveSheet.Range("A2").Value) Then

Замените 16ю строку.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori

alexdes

Пользователь

Сообщений: 147 Регистрация: 13.06.2013

#19

19.11.2015 15:24:51

Если я в файле "пример" в A2 буду искать например 5257, то при его нахождении макрос должен его добавить за уже имеющимся 5256. (т.е. при каждом удачном поиске - добавлять строчку и вставлять значения)

Изменено: alexdes - 19.11.2015 15:58:38

JayBhagavan

Пользователь

Сообщений: 11833 Регистрация: 17.01.2014

ПОЛ: МУЖСКОЙ | Win10x64, MSO2019x64

#20

19.11.2015 16:13:16

Скрытый текст

Код

Sub Кнопка1_Найти_Добавить()
Dim path As String, file As String, arg As String, i As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Укажите рабочую папку": .Show
        If .SelectedItems.Count = 0 Then
            Exit Sub
        Else
            path = .SelectedItems(1) & "\"
        End If
    End With

    Application.ScreenUpdating = False
    Application.EnableEvents = False
'    Rows("9:" & Rows.Count).ClearContents
    file = Dir(path & "*.xlsm"): i = Rows(Rows.Count).End(xlUp).Row + 1 ' изменил
    Do While file <> ""
        If Left(file, 4) = CStr(ActiveSheet.Range("A2").Value) Then
            Cells(i, 1) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("D1").Range("A1").Address(, , xlR1C1)) '№ заказа
            Cells(i, 3) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("A4").Range("A1").Address(, , xlR1C1)) 'материал
            Cells(i, 4) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("B4").Range("A1").Address(, , xlR1C1)) 'наименование
            Cells(i, 5) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("C4").Range("A1").Address(, , xlR1C1)) 'оборудование
            Cells(i, 7) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("D4").Range("A1").Address(, , xlR1C1)) 'параметр1
            Cells(i, 8) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("E4").Range("A1").Address(, , xlR1C1)) 'параметр2
            Cells(i, 9) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("F4").Range("A1").Address(, , xlR1C1)) 'кол-во
            Cells(i, 10) = ExecuteExcel4Macro("'" & path & "[" & file & "]" & "Данные'!" & Range("K4").Range("A1").Address(, , xlR1C1)) 'упаковка
            i = i + 1
        End If: file = Dir
    Loop
    Application.EnableEvents = True
End Sub

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori

Kuzmich

Пользователь

Сообщений: 8043 Регистрация: 21.12.2012

#21

19.11.2015 16:23:08

Вернуть забыли

Код
Application.ScreenUpdating = True

JayBhagavan Пользователь Сообщений: 11833 Регистрация: 17.01.2014 ПОЛ: МУЖСКОЙ \| Win10x64, MSO2019x64	#22 19.11.2015 16:24:36 Kuzmich, так оно же автоматом возвращается. Потому специально не возвращал. Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori

alexdes Пользователь Сообщений: 147 Регистрация: 13.06.2013	#23 19.11.2015 16:29:18 Всё работает, всем большое спасибо.

alexdes Пользователь Сообщений: 147 Регистрация: 13.06.2013	#24 20.11.2015 08:13:16 Возможно в этот пример добавить, чтобы поиск был в папке с подкаталогами, а не в указанной папке?

JayBhagavan Пользователь Сообщений: 11833 Регистрация: 17.01.2014 ПОЛ: МУЖСКОЙ \| Win10x64, MSO2019x64	#25 20.11.2015 10:05:59 вба поиск файлов в папке с подкаталогами Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori

alexdes Пользователь Сообщений: 147 Регистрация: 13.06.2013	#26 20.11.2015 10:50:17 Много уже всего прочитал и излазил, но без вашей помощи не разобраться мне . Изменено: alexdes - 23.11.2015 14:48:02

JayBhagavan Пользователь Сообщений: 11833 Регистрация: 17.01.2014 ПОЛ: МУЖСКОЙ \| Win10x64, MSO2019x64	#27 23.11.2015 15:24:50 Пример. Список файлов в каталоге с вложенными каталогами. Комментировать не буду, т.к. собирал сам всё из сети и форума, на что и Вы способны, если потрудитесь. Файл - переделка другого файла, потому могут быть лишние переменные и макросы. Макрос jjj. Прикрепленные файлы files_in_subfolders.xlsb (36.26 КБ) Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori