Вопрос или проблема
Мне нужно обновить 100-ы Excel рабочие книги; каждая книга имеет несколько листов (не фиксированное количество, но максимум 50);
Идея заключается в том, чтобы написать код VBA (используя Excel 2010), чтобы пройтись по всем листам и удалить целые столбцы на основе критериев. Каждый лист имеет заголовочный столбец, который начинается с:
Дата ; 2024-09-20 ; 2023-02-06 ; 2020-01-01 ; 2019-02-09 ; 1999-09-09 и так далее
Даты переменные.
Я хочу удалить все столбцы, которые относятся к 2019 году или ранее. Я совсем новичок, но это сэкономит мне много усилий; вот что я придумал, используя ответы из других постов, но это почему-то не срабатывает. На самом деле, каждый раз, когда макрос запускается, он не удаляет все столбцы на всех листах; мне нужно запустить его несколько раз и на каждом отдельном листе. Кроме того, столбцы не удаляются, а вместо этого просто очищаются данные из столбца, и пустой столбец все еще существует. Полностью в тупике.
Dim a As Long, w As Long, match1 As String
With ThisWorkbook
For w = 1 To .Worksheets.Count
With Worksheets(w)
For i = 50 To 1 Step -1
match1 = CStr(Cells(1, i))
If match1 Like "201?-*" Then
Columns(i).EntireColumn.Delete
End If
If match1 Like "200?-*" Then
Columns(i).EntireColumn.Delete
End If
If match1 Like "199?-*" Then
Columns(i).EntireColumn.Delete
End If
If match1 Like "198?-*" Then
Columns(i).EntireColumn.Delete
End If
Next i
End With
Next w
End With
Помогите, буду очень признателен.
Это не было тщательно протестировано, кроме hastily сделанной папки с тремя электронными таблицами, поэтому я бы предложил действовать осторожно и протестировать это сначала на каких-то тестовых данных на всякий случай:
Sub DeleteOldDateColumnsInDirectory()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim col As Integer
Dim headerDate As Date
' Укажите путь к папке (обновите это до вашей директории)
folderPath = "C:\folderpath\etc\"
' Отключите обновление экрана и автоматические вычисления для повышения производительности
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Получите первый .xlsx файл в папке
fileName = Dir(folderPath & "*.xlsx")
' Цикл по каждому файлу в папке
Do While fileName <> ""
' Откройте рабочую книгу
Set wb = Workbooks.Open(folderPath & fileName)
' Цикл по каждому листу в рабочей книге
For Each ws In wb.Worksheets
' Начните с последнего столбца и двигайтесь назад
For col = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column To 1 Step -1
On Error Resume Next
' Попробуйте интерпретировать заголовок как дату
headerDate = CDate(ws.Cells(1, col).Value)
On Error GoTo 0
' Если это дата и 2019 год или ранее, удалите столбец
If IsDate(headerDate) And Year(headerDate) <= 2019 Then
ws.Columns(col).Delete
End If
Next col
Next ws
' Сохраните и закройте рабочую книгу
wb.Close SaveChanges:=True
' Перейдите к следующему файлу
fileName = Dir
Loop
' Включите обновление экрана и вычисления
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Столбцы удалены во всех рабочих книгах в папке."
End Sub
Ответ или решение
Вопрос Excel VBA: Удаление нескольких столбцов в нескольких листах некоторых рабочих книг на основе определенных критериев
Если вам необходимо обновить множество рабочих книг Excel, содержащих разные листы, и при этом удалять столбцы по определённым критериям, то написание скрипта на VBA – это отличный способ автоматизировать эту задачу. Ниже представлен подробный код с пошаговым объяснением, который позволит вам удалить все столбцы с датами, относящимися к 2019 году и ранее.
Условия задачи
Ваша задача заключается в следующем:
- Имеется множество рабочих книг (до 100) с разным количеством листов (до 50).
- Каждую книгу нужно обработать и удалить столбцы, которые содержат даты 2019 года и ранее.
- В заголовке каждого листа находятся даты, формат которых может варьироваться, но все они начинаются строкой "Дата ;" и далее следуют сами даты.
Код VBA
Вы можете использовать следующий код для выполнения данной задачи:
Sub DeleteOldDateColumnsInDirectory()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim col As Integer
Dim headerDate As Date
' Укажите путь к вашей папке (обновите это в соответствии с вашим каталогом)
folderPath = "C:\folderpath\etc\"
' Отключаем обновление экрана и автоматические расчеты для повышения производительности
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Получаем первый файл .xlsx в папке
fileName = Dir(folderPath & "*.xlsx")
' Цикл по всем файлам в папке
Do While fileName <> ""
' Открываем рабочую книгу
Set wb = Workbooks.Open(folderPath & fileName)
' Цикл по всем рабочим листам в книге
For Each ws In wb.Worksheets
' Начинаем с последнего столбца и двигаемся назад
For col = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column To 1 Step -1
On Error Resume Next
' Пытаемся преобразовать заголовок в дату
headerDate = CDate(ws.Cells(1, col).Value)
On Error GoTo 0
' Если это дата и она 2019 года или ранее, удаляем столбец
If IsDate(headerDate) And Year(headerDate) <= 2019 Then
ws.Columns(col).Delete
End If
Next col
Next ws
' Сохраняем и закрываем рабочую книгу
wb.Close SaveChanges:=True
' Переходим к следующему файлу
fileName = Dir
Loop
' Включаем обновление экрана и расчеты
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Столбцы удалены во всех рабочих книгах в папке."
End Sub
Пояснение кода
-
Настройка пути к папке: Вам необходимо указать путь к директории, в которой находятся ваши рабочие книги.
-
Оптимизация производительности: Отключение обновления экрана и автоматического пересчета помогает ускорить выполнение макроса.
-
Цикл по файлам: С помощью функции
Dir
вы получаете все файлы в указанной директории и открываете каждый из них по очереди. -
Цикл по листам: Для каждого листа в открытой книге выполняется проверка всех столбцов с заголовками.
-
Проверка и удаление столбцов: Для каждого столбца проверяется, является ли содержимое заголовка датой, и если год меньше или равен 2019, то столбец удаляется.
-
Сохранение изменений: После обработки всех листов в книге изменения сохраняются, а книга закрывается.
-
Финальное сообщение: После завершения макроса выводится сообщение о том, что столбцы успешно удалены.
Рекомендации
- Тестирование: Перед запуском на больших объемах данных рекомендуется протестировать код на нескольких примерах, чтобы убедиться, что он работает корректно.
- Резервное копирование: Обязательно сделайте резервные копии ваших файлов перед запуском макроса, чтобы избежать потери данных.
Таким образом, приведенный скрипт VBA значительно упростит и автоматизирует процесс удаления старых дат из ваших рабочих книг в Excel.