🤖📊 Как я перестал тратить по 4 часа на Excel и подружился с нейросетью

text
Sub CollectData()
    ' код, который открывает диалог выбора файла и копирует активный лист
End Sub

Ты эксперт по VBA для Excel 2019. Напиши макрос с именем "СборДанных".

1. Макрос должен открывать книгу по пути C:\Data\Январь.xlsx.
2. На листе "Продажи" скопировать значения из ячеек B2:B10.
3. Закрыть книгу без сохранения.
4. В текущей книге (куда вставляем) на листе "Свод" найти первую пустую строку в столбце A и вставить туда скопированные значения одно под другим.
5. После вставки перейти на лист "Расчёт" и в ячейку C5 записать формулу =СУММ(Свод!A:A).
6. Не использовать никаких сообщений (Application.DisplayAlerts = False).
7. Обработать ошибки: если файл не найден, записать в лог на листе "Ошибки" текущую дату и имя файла.

text
Техническое задание для макроса VBA (Excel 2019, русский)

Цель: автоматический сбор данных из отчётов за месяц.

1.  Открыть папку C:\Reports\2025\.
2.  Для каждого файла с именем, содержащим "Отчёт_", выполнить:
    а) открыть файл;
    б) на листе "Данные" скопировать ячейки C5:C20;
    в) закрыть файл без сохранения;
    г) перейти в сводный файл (текущий), на лист "Сборка";
    д) найти последнюю заполненную строку в столбце A;
    е) вставить скопированные значения, начиная со следующей строки.
3.  После обработки всех файлов перейти на лист "Итог".
4.  В ячейку B2 записать формулу: =СУММ(Сборка!A:A).
5.  На листе "Лог" записать дату и время запуска макроса.
6.  Запретить появление системных сообщений.
7.  Если файл не открывается — записать ошибку в лог и продолжить со следующим.

Ограничения:
- не менять исходные файлы;
- не использовать ActiveCell, Selection — только явные ссылки;
- макрос должен запускаться по кнопке на листе "Интерфейс".

Sub СобратьДанныеИзОтчётов()
    ' Макрос для сбора данных из отчётов в папке C:\Reports\2025\
    ' Запускается с листа "Интерфейс" (можно назначить на кнопку)
    
    ' ===== ОТКЛЮЧАЕМ СИСТЕМНЫЕ СООБЩЕНИЯ И ОБНОВЛЕНИЯ =====
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' ===== ОБЪЯВЛЕНИЕ ПЕРЕМЕННЫХ =====
    Dim ПутьКПапке As String
    Dim ИмяФайла As String
    Dim ПолныйПуть As String
    Dim wbОтчёт As Workbook
    Dim wsДанные As Worksheet
    Dim ДиапазонДанных As Range
    Dim Значения As Variant
    Dim ТекущаяКнига As Workbook
    Dim wsСборка As Worksheet
    Dim wsИтог As Worksheet
    Dim wsЛог As Worksheet
    Dim ПоследняяСтрока As Long
    Dim i As Long
    Dim Ошибка As String
    
    ' ===== УСТАНАВЛИВАЕМ ССЫЛКИ НА ЛИСТЫ ТЕКУЩЕЙ КНИГИ =====
    Set ТекущаяКнига = ThisWorkbook
    Set wsСборка = ТекущаяКнига.Worksheets("Сборка")
    Set wsИтог = ТекущаяКнига.Worksheets("Итог")
    Set wsЛог = ТекущаяКнига.Worksheets("Лог")
    
    ' ===== ЗАПИСЫВАЕМ ВРЕМЯ ЗАПУСКА В ЛОГ =====
    ЗаписатьВЛог wsЛог, "Запуск макроса: " & Format(Now, "dd.mm.yyyy HH:nn")
    
    ' ===== ЗАДАЁМ ПУТЬ К ПАПКЕ С ОТЧЁТАМИ =====
    ПутьКПапке = "C:\Reports\2025\"
    
    ' ===== ПРОВЕРЯЕМ СУЩЕСТВОВАНИЕ ПАПКИ =====
    If Dir(ПутьКПапке, vbDirectory) = "" Then
        ЗаписатьВЛог wsЛог, "ОШИБКА: Папка не найдена - " & ПутьКПапке
        GoTo Завершение
    End If
    
    ' ===== ПОЛУЧАЕМ ПЕРВЫЙ ФАЙЛ =====
    ИмяФайла = Dir(ПутьКПапке & "*.xls*")   ' ищем все файлы Excel
    
    ' ===== ПЕРЕБИРАЕМ ВСЕ ФАЙЛЫ В ПАПКЕ =====
    Do While ИмяФайла <> ""
        ' Проверяем, содержит ли имя файла "Отчёт_" (регистронезависимо)
        If InStr(1, ИмяФайла, "Отчёт_", vbTextCompare) > 0 Then
            ПолныйПуть = ПутьКПапке & ИмяФайла
            
            ' Исключаем текущую книгу (на случай, если она лежит в той же папке)
            If ПолныйПуть <> ТекущаяКнига.FullName Then
                On Error Resume Next   ' временно игнорируем ошибки для открытия
                Set wbОтчёт = Workbooks.Open(ПолныйПуть, UpdateLinks:=False, ReadOnly:=True)
                On Error GoTo 0        ' возвращаем обычную обработку ошибок
                
                If wbОтчёт Is Nothing Then
                    ' Не удалось открыть файл
                    ЗаписатьВЛог wsЛог, "ОШИБКА: Не удалось открыть файл " & ИмяФайла
                Else
                    ' Файл открыт успешно
                    On Error Resume Next
                    Set wsДанные = wbОтчёт.Worksheets("Данные")
                    On Error GoTo 0
                    
                    If wsДанные Is Nothing Then
                        ' Лист "Данные" отсутствует
                        ЗаписатьВЛог wsЛог, "ОШИБКА: В файле " & ИмяФайла & " нет листа ""Данные"""
                    Else
                        ' Копируем диапазон C5:C20
                        Set ДиапазонДанных = wsДанные.Range("C5:C20")
                        Значения = ДиапазонДанных.Value   ' читаем значения в массив
                        
                        ' Определяем последнюю заполненную строку на листе "Сборка" (столбец A)
                        ПоследняяСтрока = wsСборка.Cells(wsСборка.Rows.Count, 1).End(xlUp).Row
                        If ПоследняяСтрока = 1 And wsСборка.Cells(1, 1).Value = "" Then
                            ПоследняяСтрока = 0   ' лист пуст
                        End If
                        
                        ' Вставляем значения, начиная со следующей строки
                        For i = 1 To 16
                            wsСборка.Cells(ПоследняяСтрока + i, 1).Value = Значения(i, 1)
                        Next i
                    End If
                    
                    ' Закрываем файл отчёта без сохранения
                    wbОтчёт.Close SaveChanges:=False
                    Set wbОтчёт = Nothing
                    Set wsДанные = Nothing
                End If
            End If
        End If
        
        ' Следующий файл
        ИмяФайла = Dir()
    Loop
    
    ' ===== ЗАПИСЫВАЕМ ФОРМУЛУ НА ЛИСТ "ИТОГ" =====
    wsИтог.Range("B2").Formula = "=СУММ(Сборка!A:A)"
    
    ' ===== ПЕРЕХОДИМ НА ЛИСТ "ИТОГ" =====
    wsИтог.Activate
    
    ' ===== ЗАВЕРШЕНИЕ: ВОССТАНАВЛИВАЕМ НАСТРОЙКИ =====
Завершение:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "Сбор данных завершён. Проверьте лог на наличие ошибок.", vbInformation
End Sub


' ===================================================================
' ВСПОМОГАТЕЛЬНАЯ ПРОЦЕДУРА ДЛЯ ЗАПИСИ В ЛОГ
' ===================================================================
Private Sub ЗаписатьВЛог(wsЛог As Worksheet, Текст As String)
    Dim ПоследняяСтрока As Long
    ' Определяем последнюю строку в столбце A
    ПоследняяСтрока = wsЛог.Cells(wsЛог.Rows.Count, 1).End(xlUp).Row
    If ПоследняяСтрока = 1 And wsЛог.Cells(1, 1).Value = "" Then
        ПоследняяСтрока = 0
    End If
    ' Добавляем запись в следующую строку
    wsЛог.Cells(ПоследняяСтрока + 1, 1).Value = Текст
    ' Автоподбор ширины столбца для удобства
    wsЛог.Columns(1).AutoFit
End Sub