Спасибо, всё работает.
Есть внутренние косяки. Если в имени нет обозначения "КПДМ......" то выдаёт ошибку.
Но в данном случае это проблемы личного характера и вопросы к конструктору, который прислал комплект чертежей с файлами без обозначений.

Здравствуйте.
Спасибо, воспользовался вашим файлом.
Но при этом прошу помощи. При сохранении файлов с одинаковыми именами выдаёт ошибку.
Прошу что-то добавить что-бы если такое имя уже существует, то к имени он добавлял (1), (2), (3) и т.д.
Пример своего файла приложил.
Прошу не смеяться над тем как я соединил макросы и как сделал способ переименования.

Доброе утро. Продолжаю беспокоить и спрашивать:

проблема на следующей строке (Line Input #ff, txt), выдаёт ошибку "input past end file"

Open "C:\Users\account\Desktop\sol.txt" - не создавая файл не помогло. Создал сам.

Появилась другая проблема на следующей строке (Line Input #ff, txt), не читает "input past end file"

Здравствуйте.
На просторах интернета нашёл двухмерный раскрой.
На строке "Open "sol.txt" For Input As #ff 'чтение решения и вывод результата"
Пишет файл не найден.

Прошу помощи.

В имена файлов которые нужно копировать? Если так то не получиться. Получаю комплект КД где сотни файлов и все переименовывать не вариант. Тогда скопирую в ручную. Или я не про те имена понял?

И я взял именно Ваше решение и его буду использовать. СПАСИБО.

Строка
     'If f.Name Like fls(r, 1) Then
не работает

Заменил на
       If InStr(1, f, Cells(r, 1)) > 0 Then
заработало.

СПАСИБО.

Возможно я не правильно высказался, если в разных папках одинаковые файлы ну и ладно. Пример: критерий (123), файлы в папках "фва123щш", "6516пкк", "654123мк", "12365", "ыкап124маку", "6516пкк" . И задача что бы он скопировал 1, 3 и 4 файлы. А 6 файл уже скопирован. Поэтому даже если он будет скопирован, он заменит тот что уже есть.
Файлы это чертежи. И  если кто сталкивался с ресурсной спецификацией, то по факту это поиск и копирование всех чертежей которые нужны для изготовления изделия.

И для этого у меня добавлено:
   
For Each objFile In objFolder.Files
       For q = 2 To w
           If InStr(1, objFile, Cells(q, 1)) > 0 Then
               Cells(q, 1).Interior.Color = vbYellow
               
               FileCopy objFile, sFolder1 ' копирование (не получается)
               
               objFolder.copyFile objFile, sFolder1 ' копирование (не получается)
               
               Exit For
           End If
       Next
Next
Получается я не нахожу файл который соответствует критерию, я проверяю каждый файл на соответствие критерия (содержание ячеек).

Прочитав своё сообщение понял проблему. Это не техническое сообщение, а какой-то крик души.

Задача: Поиск и копирование файлов в названии которых встречается полное совпадение со значениями указанными в первом столбце (процесс не останавливается при первом совпадении, а проверяет все файлы). Просмотр и копирование происходит из папки и подпапок находящихся в ней, в одну папку. Обе первоначальные папки (от куда и куда копировать) указываются при запуске макроса.

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

Из указанных здесь ссылок собрал своё, не копирует. В другом чате выложил вариант копирования всех файлов с поиском по имени. Но там только из одной папки.
В примере, на который указывают ссылки, нет копирования. А где есть копирование, то там только из одной папки.
Вот мой вариант. Прошу помощи.

Сделал.
Пошёл другим путём.

Здравствуйте.
Нашёл похожий вариант. Сейчас он копирует только один файл. Нашёл один, скопировал, и переключается на поиск другого имени.
Как его доработать что бы он копировал все файлы в имени которых нашёл искомое значение?

УРА!!!! СПАСИБО!!!

Такой вариант даже не видет файл.

Вот мой полный код:

Sub открыть_чертёж()
Dim q As String
Dim Route As String
Dim myShell As Object

On Error Resume Next
Set myShell = CreateObject("WScript.Shell")
Cells(ActiveCell.Row, 1).Select

q = Cells(ActiveCell.Row, 1).Value

Route = "C:\Users\account\Desktop\КД\"

myShell.Run Route & Dir(Route & """" & q & """")

'myShell.Run Route & Dir(Route & "*" & q & "*")

End Sub

Вариант с "*" открывает любой файл, где в имени файла есть значение ячейки. Но как только в имени появляется пробел, он его видит но не открывает.

Может задачу можно решить другим способом, поэтому поясню принцип задачи.

Есть папка с чертежами. В экселе перечислены все файлы. Задача: в экселе, двойным нажатием на ячейку в котором находиться "КПДМ.741124.447" открывается файл находящийся в папке с именем "Пластина КПДМ.741124.447_под опору.jpg".

myShell.Run Route & Dir(Route & "*" & q & "*")

Как оказалось помогло, но не до конца.

Пробел не воспринимает. Файл находит, но не открывает.

ПОМОГИТЕ.

Спасибо. Помогло.

Про маски буду читать.

Здравствуйте.

Сейчас открывает файл только при полном совпадении имени и расширении.

Как открыть файл, если известно только часть имени и расширение не .pdf, а например .png?


q = Cells(ActiveCell.Row, 1).Value
route = "C:\Users\account\Desktop\печать\"
myShell.Run route & q & ".pdf"


p.s. посидел 2 часа в поиске ответа на форуме. Не нашёл.

MCH, спасибо за предоставленную ссылку. То что нужно.

Написал Вам сообщение, в личку, по вопросу доработки Вашего решения моей задачи. Прошу ответить.

Есть конструкция, сборочно-сварная, которое состоит из множества деталей. Материал деталей одинаковый (предположим швеллер). Но материал может меняться. Это необходимо для подсчёта веса.
Размер деталей 1200мм-4шт, 850мм-4шт, 760мм-5шт, 230мм-1шт, 185мм-7шт.
Заготовка 6000 мм или 4000 мм (она должно быть изменяемой)
Задача:
1-посчитать сколько необходимо выдать материала со склада (мин.  кол-во заготовок и общий вес выдаваемого материала) что бы изготовить детали.
2-сообщить сколько останется от каждой заготовки после отрезки деталей (для возможности использовать в дальнейшем).
3-всю информацию вывести на лист, где будет сказано какие детали необходимо отрезать от каждой заготовки, а так же первые 2 пункта.

Решение приложено в первом посте. Но там у меня использовано 20 деталей это около миллиона комбинаций. Время работы макроса 13 сек. При большем количестве (нужно до 100 деталей), это мин. 100891344545564193334812497256 комбинаций.

Поэтому я спрашиваю может есть другой способ перебора? Отличного от моего?

С учётом пропила. В макросе он учитывается "толщина реза". Пилить пилой. Материал швеллер, труба, профильная труба, пруток. Для лазерного станка используем специальную прогу и получаем лист раскроя.

Предполагаю что с помощью массива скорость обработки данных увеличится, но принцип перебора данных в массиве и выдачи его наилучшего результата мне не ясен.

Общий смысл:
Необходимо изготовить 100 деталей различной длинны. Длинна заготовки 6000 мм. необходимо оптимально разложить детали, что бы получить минимальный отход. Оставшиеся детали оптимально разложить на следующей заготовке и т.д.

Конкретнее:
Есть 100 различных значений (могут повторяться).
Необходимо найти значения, сумма которых, будет максимально близка к определённому значению. Выписать все значения и удалить их из общего списка.
С оставшимися значениями проделать процедуру описанную выше.

На данный момент у меня получается из 20 значений выбрать оптимальный вариант. Но при увеличении количества первоначальных значений, увеличивается время расчёта, почти в геометрической прогрессии, .

Пример приложил.

Это называется: я строю дом а из инструмента у меня только молоток, топор и фантазия.
Я открываю ваш пример и НИЧЕГО не понимаю. А значит применить, а уж тем более изменить его могу методом научного тыка. С формулами я уже более-менее разобрался.
Если есть желание могу лично скинуть файл где все формы, переходы, таблицы со значениями из сетевых источников.

Вот.

Сделал.
в начале сортировки поставил очистку ListBox, а саму сортировку поставил на Click ListBox. В активации формы тоже оставил сортировку. Думаю сортировку поставить на изменение TextBox куда заполняю критерий. Выложу в течении дня.

Последний пример идеально подходит к моей задачи
УРА. ВСЕМ СПАСИБО.

В поиске пройдусь по всему вашему списку. Спасибо.

Jack Famous, согласен. Теперь только нужно от туда достать то, что нужно мне, буду работать. Только если бы вы видели мои коды, то поняли, что я в первом классе, а вы в 11.
открыл, читаю, ничего не понимаю.

Спасибо. Буду искать и пробовать.

Спасибо. Поставил. Но есть одно НО. Я хочу сделать так что бы исполнитель работал только с формами и не касался таблиц экселя. В прикладываемый файл я оставил только одну форму. По факту их сейчас 4 будет около 8.
поэтому требуется именно автоматическое изменение и сортировка объекта ListBox.

Вот. Только там теперь не столбец LZ, a AB