Применение макроса ко всем Excel файлам в папке по заданному пути

@Vlad1792 · Регистрация: 29.07.2020

Студворк — интернет-сервис помощи студентам

Есть общиймакрос, в котором содержатся 6 макросов, последовательно выполняющих свои действия к одинаковым по структуре файлам (файл с кодом во вложении).
Можно ли добавить к этому коду следующие действия → выбрать Путь к папке с Exel файлами, к которым требуется применение данного кода, с последующим сохранением файлов после выполнение операций.

P.S. Большее кол-во действий записано через : Конструктор → запись макроса. (как умею, только учусь)
По поиску схожих тем на форуме, решение не нашел. Есть похожее, но только с одним действием (макросом).

Заранее благодарен!

@Hugo121 · 02.09.2020, 18:23

Указать макросу каталог нет особых проблем, можно брать любой код где есть Application.FileDialog(msoFileDialogFold erPicker), но проще будет дать макросу список файлов (Application.FileDialog(msoFileDialogFil ePicker)).
Потому что если только каталог - нужен код перебора всех файлов.
Но сперва нужно в этих 6 макросах разобраться с каким листом они вообще работают (в паре есть указания, а остальные тупо работают с чем попало).
Тогда можно выполнить ещё один основной макрос, который в цикле окрывает очередной файл, вызывает Общиймакрос(), тот выполняет с файлом те 6, затем основной макрос закрывает файл с сохранением.

@Burk · 02.09.2020, 18:27

Мда ... "Не стреляйте в пианиста, он играет как умеет." А почему макросы поместили в текстовый файл, а отослать экселевский трудно, расширение xlsm не пропускает? Послать в архиве или сохранить как файл с расширением xls без архивации. Но перед этим можете уменьшить код хотя бы убрав практически все Selection, ну так макрорекодер создает макросы, поэтому лучше подредактировать его макросы. Для примера, вместо

Visual Basic
1
2
3
4
    Columns("W:W").Select
    Selection.ColumnWidth = 10.14
' лучше записать напрямую
    Columns("W:W").ColumnWidth = 10.14

@Vlad1792 · 03.09.2020, 10:02 **[ТС]**

Добрый день,

Файл *xlsm (в архиве) во вложении.

@Vlad1792 · 03.09.2020, 10:08 **[ТС]**

Burk, про Пианиста это ты в точку!) Спасибо поднял настроение.
К сожалению я не программист, в письме я это подчеркнул - не судите строго.

Однако данный макрос, пусть и написан на коленках в макрорекодере - но он очень выручает меня.

Все что бы хотелось бы сделать - это массовая обработка ... (файл *xlsm выше )

@Narimanych · 03.09.2020, 11:28

Vlad1792,
Иногда легче написать заново, чем поправлять /переделывать "чужой" код.
Приведите ваше Т.З. Возможно, ребята вам здесь найдут более рациональный способ решения...

@Hugo121 · 03.09.2020, 11:42

На мой пост реакции наверное не будет... Ну я тогда пошёл по другим делам.

@КостяФедореев · 03.09.2020, 11:59

Vlad1792,

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub Folder()
    Dim sFolder As String, sFiles As String
    Dim wb As Workbook
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        Set wb = Application.Workbooks.Open(sFolder & sFiles)
        
        Макрос1
        Макрос2
        Макрос3
        Макрос4
        Макрос5
        Макрос6
        
        wb.Close True
        sFiles = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Перебор всех фалов в папке

@Vlad1792 · 03.09.2020, 12:23 **[ТС]**

Все спасибо !
Удалось реализовать следующим способом:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub OpenDialod()
    Dim ipath$, fname$, book As Workbook
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then ipath = .SelectedItems(1) Else Exit Sub
    End With
    fname = Dir(ipath & "\*.xls*")
    Do While fname <> ""
        Set book = Workbooks.Open(ipath & Application.PathSeparator & fname)
        Call Общиймакрос
        book.Close True
        fname = Dir
    Loop
End Sub

@Burk · 03.09.2020, 12:41

Vlad1792, да никто и не судит, я даже в восхищении. Иногда пишешь, что бы воспользовались рекодером, но как-то не обращают внимания. А вы такой проект записали макрорекодером! Только надо бы его потом оптимизировать, как я писал. На всякий случай для примера подрисовал Макрос1.
А теперь про массовую обработку - Hugo121 ведь вам писал,. Или можно просто завести папку с файлами (.xlsx) для обработки, имена у них сделать по какому-то шаблону и перебирать их запуском ОбщегоМакроса. Перебор файлов тоже вставить в этот макрос. Про Application.FileDialog Hugo121 знает лучше меня, я делал по-простому через функцию Dir. Кстати, а ширина колонок, например 7.26 и 7.75 это принципиально, может можно уменьшить подобное разнообразие и ещё сократить макрос.

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub Макрос1()
Dim I As Integer
    Columns("Y:Y").Delete Shift:=xlToLeft
    'а то, что АС после удаления сдвинется это ничего?
    For I = 1 To 5: Columns("AC:AC").Insert Shift:=xlToRight: Next
    Range("table1[[#Headers],[Unit of Measurement 12]]").Select
    Columns("V:AG").NumberFormat = "0.000"
    Columns("A:A").ColumnWidth = 12.29
    Columns("B:B").ColumnWidth = 10.14
    Columns("C:C").ColumnWidth = 11.29
    Range("D:F,K:L").ColumnWidth = 6.43
    Columns("G:G").ColumnWidth = 8.29
    Range("H:J").ColumnWidth = 10.71
    Columns("M:M").ColumnWidth = 7.29
    Columns("N:N").ColumnWidth = 18.43
    Columns("O:O").ColumnWidth = 9.71
    Columns("P:P").ColumnWidth = 7.86
    Columns("Q:Q").ColumnWidth = 4.86
    Columns("R:R").ColumnWidth = 18.86
    Columns("S:S").ColumnWidth = 22.43
    Columns("T:T").ColumnWidth = 5.86
    Columns("U:U").ColumnWidth = 14.29
    Range("V:W,Y:AA").ColumnWidth = 10.14
    Columns("X:X").ColumnWidth = 5.29
    Columns("AB:AB").ColumnWidth = 5.14
    Columns("AC:AG").ColumnWidth = 15.4
    Columns("AH:AL").ColumnWidth = 10.86
    Range("AC4").Formula = "=Z3-15"
Range("AD4").Formula = "=Z3-AC4"
Range("AE4").Formula = "=W4+AC4"
Range("AF4").Formula = "=1"
Range("AG4").Formula = "=1"
Range("AC2:AG3").ClearContents
Selection.AutoFilter
    ActiveSheet.ListObjects("table1").Range.AutoFilter Field:=29, Criteria1:= _
        "-15,000"
    Columns("AC:AD").ClearContents
    Columns("AF:AG").ClearContents
    ActiveSheet.ListObjects("table1").Range.AutoFilter Field:=29
    Columns("AE:AE").ClearContents
    ActiveSheet.ListObjects("table1").Range.AutoFilter Field:=31, Criteria1:= _
        "0,000"
    ActiveSheet.ListObjects("table1").Range.AutoFilter Field:=31
    Range("AC1") = "Вес упаковки"
Range("AD1") = "Вес паллет"
Range("AE1") = "Вес брутто без паллет"
Range("AF1") = "кол-во упаковок"
Range("AG1") = "кол-во паллет"
    Columns("AC:AG").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AC1").Select
End Sub

@Vlad1792 · 03.09.2020, 14:56 **[ТС]**

Burk, благодарю! лишние Selection в коде убрал.
Это заметно ускорило работу макроса.

С массовой обработкой разобрались, писал выше)

Новые блоги и статьи Все статьи Все блоги /
PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Access VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .
Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .

@Hugo121 6997 / 2895 / 555 Регистрация: 19.10.2012 Сообщений: 8,803
	02.09.2020, 18:23
	Указать макросу каталог нет особых проблем, можно брать любой код где есть Application.FileDialog(msoFileDialogFold erPicker), но проще будет дать макросу список файлов (Application.FileDialog(msoFileDialogFil ePicker)). Потому что если только каталог - нужен код перебора всех файлов. Но сперва нужно в этих 6 макросах разобраться с каким листом они вообще работают (в паре есть указания, а остальные тупо работают с чем попало). Тогда можно выполнить ещё один основной макрос, который в цикле окрывает очередной файл, вызывает Общиймакрос(), тот выполняет с файлом те 6, затем основной макрос закрывает файл с сохранением. 1

@Vlad1792 1 / 1 / 0 Регистрация: 29.07.2020 Сообщений: 42
	03.09.2020, 10:08 [ТС]
	Burk, про Пианиста это ты в точку!) Спасибо поднял настроение. К сожалению я не программист, в письме я это подчеркнул - не судите строго. Однако данный макрос, пусть и написан на коленках в макрорекодере - но он очень выручает меня. Все что бы хотелось бы сделать - это массовая обработка ... (файл *xlsm выше ) 0

@Narimanych 2751 / 1725 / 779 Регистрация: 23.03.2015 Сообщений: 5,449
	03.09.2020, 11:28
	Vlad1792, Иногда легче написать заново, чем поправлять /переделывать "чужой" код. Приведите ваше Т.З. Возможно, ребята вам здесь найдут более рациональный способ решения... 0

@Hugo121 6997 / 2895 / 555 Регистрация: 19.10.2012 Сообщений: 8,803
	03.09.2020, 11:42
	На мой пост реакции наверное не будет... Ну я тогда пошёл по другим делам. 0

@Vlad1792 1 / 1 / 0 Регистрация: 29.07.2020 Сообщений: 42
	03.09.2020, 14:56 [ТС]
	Burk, благодарю! лишние Selection в коде убрал. Это заметно ускорило работу макроса. С массовой обработкой разобрались, писал выше) 0