Ребят. Помогите макросом, если есть у кого готовый, вообще супер. Мне нужно скопировать (в выделенном диапазоне) ФАЙЛЫ по адресам в столбце C в ПАПКИ по адресам в ячейке B. Лист 123
Ребят. Помогите макросом, если есть у кого готовый, вообще супер. Мне нужно скопировать (в выделенном диапазоне) ФАЙЛЫ по адресам в столбце C в ПАПКИ по адресам в ячейке B. Лист 123ni4esse
и уж тем более у вас тут корешей нет. Мы с вами водку не пили и кашу не ели с одной тарелки. И уж тем более в одном окопе не сидели. Уважение и Этику никто ещё не отменял. Не важно с какой вы стороны.
и уж тем более у вас тут корешей нет. Мы с вами водку не пили и кашу не ели с одной тарелки. И уж тем более в одном окопе не сидели. Уважение и Этику никто ещё не отменял. Не важно с какой вы стороны.MikeVol
Ученик. Одесса - Украина
Сообщение отредактировал MikeVol - Суббота, 14.10.2023, 22:56
и уж тем более у вас тут корешей нет. Мы с вами водку не пили и кашу не ели с одной тарелки. И уж тем более в одном окопе не сидели. Уважение и Этику никто ещё не отменял. Не важно с какой вы стороны.
Вы про что, уважаемый. Правила форума не конкретизируют форму обращения, значит она свободная. Если форма обращения не понравилась, а по существу вопроса сказать нечего, иди мимо. Про этикет и мораль имеет смысл читать лекции жене, детям или в церковно приходской. Это форум про Эксель.
и уж тем более у вас тут корешей нет. Мы с вами водку не пили и кашу не ели с одной тарелки. И уж тем более в одном окопе не сидели. Уважение и Этику никто ещё не отменял. Не важно с какой вы стороны.
Вы про что, уважаемый. Правила форума не конкретизируют форму обращения, значит она свободная. Если форма обращения не понравилась, а по существу вопроса сказать нечего, иди мимо. Про этикет и мораль имеет смысл читать лекции жене, детям или в церковно приходской. Это форум про Эксель.ni4esse
Sub copy_() Dim arr, i As Long, fileName As String, address_ As String With ActiveSheet If get_filename(Selection.Address, "^\$B\$[0-9]+\:\$C\$[0-9]+$") = "" Then MsgBox "адрес диапазона не в пределах столбцов В и С!!!!": Exit Sub arr = Selection For i = LBound(arr, 1) To UBound(arr, 1) fileName = get_filename(arr(i, 2), "[^\\]+$") FileCopy arr(i, 2), arr(i, 1) & "\" & fileName Next i End With End Sub Private Function get_filename(what, pattern) As String With CreateObject("Vbscript.Regexp") .Global = False: .MultiLine = False: .Ignorecase = True: .pattern = pattern If .test(what) Then get_filename = .Execute(what)(0): Exit Function End With get_filename = "" End Function
[/vba] Выделяете 2 столбца В и С и запускаете макрос. Макрос работает так: в столбце В указывается папка назначения. При помощи регулярного выражения из столбца С вырезается имя файла. Затем при помощи оператора FileCopy файл сохраняется в папку из столбца В с именем из столбца С (исходное имя) В случае, если выбранный диапазон не пересекается с В:С, то выскакивает сообщение "адрес диапазона не в пределах столбцов В и С!!!!"
ni4esse, добрый день! Вариант: [vba]
Код
Sub copy_() Dim arr, i As Long, fileName As String, address_ As String With ActiveSheet If get_filename(Selection.Address, "^\$B\$[0-9]+\:\$C\$[0-9]+$") = "" Then MsgBox "адрес диапазона не в пределах столбцов В и С!!!!": Exit Sub arr = Selection For i = LBound(arr, 1) To UBound(arr, 1) fileName = get_filename(arr(i, 2), "[^\\]+$") FileCopy arr(i, 2), arr(i, 1) & "\" & fileName Next i End With End Sub Private Function get_filename(what, pattern) As String With CreateObject("Vbscript.Regexp") .Global = False: .MultiLine = False: .Ignorecase = True: .pattern = pattern If .test(what) Then get_filename = .Execute(what)(0): Exit Function End With get_filename = "" End Function
[/vba] Выделяете 2 столбца В и С и запускаете макрос. Макрос работает так: в столбце В указывается папка назначения. При помощи регулярного выражения из столбца С вырезается имя файла. Затем при помощи оператора FileCopy файл сохраняется в папку из столбца В с именем из столбца С (исходное имя) В случае, если выбранный диапазон не пересекается с В:С, то выскакивает сообщение "адрес диапазона не в пределах столбцов В и С!!!!"jun
jun, Спасибо огромное. Отлично работает. Еще вопрос, если можно конечно. Что мне нужно поменять в коде, в случае если сдвинуться адреса относительно столбцов. т.е. адреса Папок окажутся в столбце С а адреса файлов в столбце D.
jun, Спасибо огромное. Отлично работает. Еще вопрос, если можно конечно. Что мне нужно поменять в коде, в случае если сдвинуться адреса относительно столбцов. т.е. адреса Папок окажутся в столбце С а адреса файлов в столбце D.ni4esse
Сообщение отредактировал ni4esse - Воскресенье, 15.10.2023, 14:02
В этой строке кода: If get_filename(Selection.Address, "^\$B\$[0-9]+\:\$C\$[0-9]+$") = "" Then MsgBox "адрес диапазона не в пределах столбцов В и С!!!!": Exit Sub поменять строку (выделено красным) В и С на С и D соответственно: [vba]
Код
"^\$C\$[0-9]+\:\$D\$[0-9]+$"
[/vba] P.S: макрос работает только по одному выделению за раз. То есть, если будут выделены несвязные диапазоны (например В2:С2,В5:С5) одновременно, то макрос работать не будет.
В этой строке кода: If get_filename(Selection.Address, "^\$B\$[0-9]+\:\$C\$[0-9]+$") = "" Then MsgBox "адрес диапазона не в пределах столбцов В и С!!!!": Exit Sub поменять строку (выделено красным) В и С на С и D соответственно: [vba]
Код
"^\$C\$[0-9]+\:\$D\$[0-9]+$"
[/vba] P.S: макрос работает только по одному выделению за раз. То есть, если будут выделены несвязные диапазоны (например В2:С2,В5:С5) одновременно, то макрос работать не будет.jun
Сообщение отредактировал jun - Воскресенье, 15.10.2023, 14:13
- наверное потому, что использовали русские буквы (они очень похожи с английскими). Просто в таблице символов они имеют разные коды. По ссылке можно посмотреть цифровые коды Кириллицы и Латиницы.
- наверное потому, что использовали русские буквы (они очень похожи с английскими). Просто в таблице символов они имеют разные коды. По ссылке можно посмотреть цифровые коды Кириллицы и Латиницы.jun