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

Вход

Регистрация

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

 

= Мир MS Excel/Копирование файлов в папки по адресам - Мир MS Excel

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

Ребят. Помогите макросом, если есть у кого готовый, вообще супер. Мне нужно скопировать (в выделенном диапазоне) ФАЙЛЫ по адресам в столбце C в ПАПКИ по адресам в ячейке B. Лист 123
К сообщению приложен файл: sobirator.xlsx (26.5 Kb)


Сообщение отредактировал ni4esse - Воскресенье, 15.10.2023, 00:21
 
Ответить
СообщениеРебят. Помогите макросом, если есть у кого готовый, вообще супер. Мне нужно скопировать (в выделенном диапазоне) ФАЙЛЫ по адресам в столбце C в ПАПКИ по адресам в ячейке B. Лист 123

Автор - ni4esse
Дата добавления - 14.10.2023 в 16:52
MikeVol Дата: Суббота, 14.10.2023, 21:51 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 291
Репутация: 51 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Ребят
и уж тем более у вас тут корешей нет. Мы с вами водку не пили и кашу не ели с одной тарелки. И уж тем более в одном окопе не сидели. Уважение и Этику никто ещё не отменял. Не важно с какой вы стороны.


Ученик.

Сообщение отредактировал MikeVol - Суббота, 14.10.2023, 22:56
 
Ответить
Сообщение
Ребят
и уж тем более у вас тут корешей нет. Мы с вами водку не пили и кашу не ели с одной тарелки. И уж тем более в одном окопе не сидели. Уважение и Этику никто ещё не отменял. Не важно с какой вы стороны.

Автор - MikeVol
Дата добавления - 14.10.2023 в 21:51
ni4esse Дата: Воскресенье, 15.10.2023, 00:29 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 0% ±

и уж тем более у вас тут корешей нет. Мы с вами водку не пили и кашу не ели с одной тарелки. И уж тем более в одном окопе не сидели. Уважение и Этику никто ещё не отменял. Не важно с какой вы стороны.

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

Вы про что, уважаемый. Правила форума не конкретизируют форму обращения, значит она свободная. Если форма обращения не понравилась, а по существу вопроса сказать нечего, иди мимо. Про этикет и мораль имеет смысл читать лекции жене, детям или в церковно приходской. Это форум про Эксель.

Автор - ni4esse
Дата добавления - 15.10.2023 в 00:29
jun Дата: Воскресенье, 15.10.2023, 09:53 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 141
Репутация: 42 ±
Замечаний: 0% ±

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 файл сохраняется в папку из столбца В с именем из столбца С (исходное имя)
В случае, если выбранный диапазон не пересекается с В:С, то выскакивает сообщение "адрес диапазона не в пределах столбцов В и С!!!!"
К сообщению приложен файл: sobirator.xlsb (32.1 Kb)


Сообщение отредактировал jun - Воскресенье, 15.10.2023, 10:42
 
Ответить
Сообщение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
Дата добавления - 15.10.2023 в 09:53
ni4esse Дата: Воскресенье, 15.10.2023, 14:01 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 0% ±

jun, Спасибо огромное. Отлично работает. Еще вопрос, если можно конечно. Что мне нужно поменять в коде, в случае если сдвинуться адреса относительно столбцов. т.е. адреса Папок окажутся в столбце С а адреса файлов в столбце D.


Сообщение отредактировал ni4esse - Воскресенье, 15.10.2023, 14:02
 
Ответить
Сообщениеjun, Спасибо огромное. Отлично работает. Еще вопрос, если можно конечно. Что мне нужно поменять в коде, в случае если сдвинуться адреса относительно столбцов. т.е. адреса Папок окажутся в столбце С а адреса файлов в столбце D.

Автор - ni4esse
Дата добавления - 15.10.2023 в 14:01
jun Дата: Воскресенье, 15.10.2023, 14:10 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 141
Репутация: 42 ±
Замечаний: 0% ±

В этой строке кода:
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 - Воскресенье, 15.10.2023, 14:13
 
Ответить
СообщениеВ этой строке кода:
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
Дата добавления - 15.10.2023 в 14:10
ni4esse Дата: Воскресенье, 15.10.2023, 14:17 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 0% ±

хм. ранее пробовал, не вышло. сейчас поменял, все отлично работает. Категорически Вам благодарен.
 
Ответить
Сообщениехм. ранее пробовал, не вышло. сейчас поменял, все отлично работает. Категорически Вам благодарен.

Автор - ni4esse
Дата добавления - 15.10.2023 в 14:17
jun Дата: Воскресенье, 15.10.2023, 14:31 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 141
Репутация: 42 ±
Замечаний: 0% ±

не вышло
- наверное потому, что использовали русские буквы (они очень похожи с английскими). Просто в таблице символов они имеют разные коды.
По ссылке можно посмотреть цифровые коды Кириллицы и Латиницы.
 
Ответить
Сообщение
не вышло
- наверное потому, что использовали русские буквы (они очень похожи с английскими). Просто в таблице символов они имеют разные коды.
По ссылке можно посмотреть цифровые коды Кириллицы и Латиницы.

Автор - jun
Дата добавления - 15.10.2023 в 14:31
ni4esse Дата: Воскресенье, 15.10.2023, 16:13 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 0% ±

jun, я Вам в личку написал. по другому вопросу.
 
Ответить
Сообщениеjun, я Вам в личку написал. по другому вопросу.

Автор - ni4esse
Дата добавления - 15.10.2023 в 16:13
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование файлов в папки по адресам (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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