Макрос Excel (VBA) для автоматической подгонки ширины столбцов по заголовкам

Нужно изменить ширину 26 столбцов в Excel по заголовкам столбцов, причём каждому столбцу назначается своя фиксированная ширина и автоподгонка не подходит. Автор задачи не хотел автоподгонку и хотел задавать ширины именно по заголовкам, а не по их текущему положению. При попытке написать макрос возникала ошибка «object required», и требовалось простое, надёжное решение для применения ширин.

В статье показан исходный пример заголовков, проблемный макрос и рабочее решение с таблицей управления и макросом, который динамически применяет ширины. Приведённый подход использует лист Control и именованную таблицу columnWidths с колонками SheetName, ColumnHeader и ColumnWidth. Это позволяет менять ширины независимо от фактического расположения столбцов на листах.

Исходная задача и примеры заголовков

Необходимо задать ширину для 26 столбцов по их заголовкам, а не по позиции. Примеры заголовков включают: Order, Status, Description, Usage, Cost, Sell Price, Margin, Notes и т. д. Важно сохранить порядок и конкретные ширины для каждого из 26 столбцов.

Автор имел небольшой опыт в написании макросов и привёл пробный код, который вызывал ошибку. Ниже — исходный макрос, с которым возникла проблема «object required». Код оставлен в оригинальном виде для наглядности и отладки.

Sub Macro1()
   With Sheet4.Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Resize(, 26)
      .Value = Array("Order", "Status", "Category 1", "Mfg. Name - Admin", "Mfg. Part # - Admin", "Competitor Name - Admin", "Competitor Part # - Admin", "Description - Admin", "Usage", "Last Price Paid", "Exact/Sub", "Exact/Sub FNL #", "Exact/Sub UOM", "Exact/Sub MFG Name", "COGS/UOM Exact or Sub", "Ext. COGS Exact or Sub", "Cost Type", "Sell Price/UOM Exact or Sub", "Ext. Sell Exact or Sub", "Margin Exact or Sub", "Core File Hit Exact or Sub", "SPA Guidance Exact or Sub", "Costing and Pricing Notes", "Exact Recommended Markup", "Sub EB Reference", "Sub Recommended Markup")
      .Resize(, 1).ColumnWidth = 4
      .Offset(, 1).Resize(, 1).ColumnWidth = 7
      .Offset(, 2).Resize(, 2).ColumnWidth = 10
      .Offset(, 3).Resize(, 3).ColumnWidth = 9
      .Offset(, 4).Resize(, 4).ColumnWidth = 10
      .Offset(, 5).Resize(, 5).ColumnWidth = 10
      .Offset(, 6).Resize(, 6).ColumnWidth = 10
      .Offset(, 7).Resize(, 7).ColumnWidth = 10
      .Offset(, 8).Resize(, 8).ColumnWidth = 18
      .Offset(, 9).Resize(, 9).ColumnWidth = 6
      .Offset(, 10).Resize(, 10).ColumnWidth = 6
      .Offset(, 11).Resize(, 11).ColumnWidth = 5
      .Offset(, 12).Resize(, 12).ColumnWidth = 9
      .Offset(, 13).Resize(, 13).ColumnWidth = 7
      .Offset(, 14).Resize(, 14).ColumnWidth = 12
      .Offset(, 15).Resize(, 15).ColumnWidth = 11
      .Offset(, 16).Resize(, 16).ColumnWidth = 11
      .Offset(, 17).Resize(, 17).ColumnWidth = 11
      .Offset(, 18).Resize(, 18).ColumnWidth = 11
      .Offset(, 19).Resize(, 19).ColumnWidth = 11
      .Offset(, 20).Resize(, 20).ColumnWidth = 11
      .Offset(, 21).Resize(, 21).ColumnWidth = 8
      .Offset(, 22).Resize(, 22).ColumnWidth = 8
      .Offset(, 23).Resize(, 23).ColumnWidth = 8
      .Offset(, 24).Resize(, 24).ColumnWidth = 13.71
      .Offset(, 25).Resize(, 25).ColumnWidth = 9
      .Offset(, 26).Resize(, 26).ColumnWidth = 13.71
   End With
End Sub

Решение: таблица управления и модуль VBA

Решение основано на создании листа Control и именованной таблицы columnWidths с тремя столбцами: SheetName, ColumnHeader и ColumnWidth. Таблица хранит соответствие между именем листа, заголовком столбца и желаемой шириной, что позволяет применять ширины независимо от позиции столбца. Такой подход удобен для управления множеством листов и колонок без правки самого макроса.

Создайте модуль в проекте VBA и вставьте предложенный макрос. Ниже приведён рабочий код, который читает таблицу columnWidths и применяет указанные ширины на соответствующих листах. Код использует ThisWorkbook, ListObject и функцию Application.Match для поиска заголовка в первой строке листа.

Option Explicit


Public Sub ResizeColumns()

    Dim wb As Workbook
    Dim wsControl As Worksheet
    Dim tblColumnWidths As ListObject
    Dim rw As ListRow
    Dim ws As Worksheet
    Dim sheetName As String
    Dim columnName As String
    Dim colWidth As Double
    Dim columnIndex As Variant
    
    Set wb = ThisWorkbook
    Set wsControl = wb.Worksheets("Control")
    Set tblColumnWidths = wsControl.ListObjects("columnWidths")
    
    For Each rw In tblColumnWidths.ListRows
        
        sheetName = rw.Range.Cells(1, 1).Value
        columnName = rw.Range.Cells(1, 2).Value
        colWidth = rw.Range.Cells(1, 3).Value
        
        Set ws = wb.Worksheets(sheetName)
        
        columnIndex = Application.Match(columnName, ws.Rows(1), 0)
        
        If Not IsError(columnIndex) Then
            ws.Columns(columnIndex).columnWidth = colWidth
        Else
            Debug.Print "Column '" & columnName & "' not found in sheet '" & sheetName & "'"
        End If
        
    Next rw

End Sub

Как этот макрос работает

Макрос открывает книгу ThisWorkbook и находит лист Control с таблицей columnWidths. Для каждой строки таблицы он читает значения SheetName, ColumnHeader и ColumnWidth. Затем по заголовку (в первой строке целевого листа) находит индекс столбца с помощью Application.Match и устанавливает ws.Columns(columnIndex).ColumnWidth равным указанному значению.

Если заголовок не найден, макрос выводит сообщение в Immediate окно (Debug.Print) о том, что соответствующий столбец не найден. Такой подход гарантирует, что ширина будет применена к правильному столбцу независимо от его текущей позиции на листе. Можно добавлять в таблицу записи для разных листов — макрос обработает их автоматически.

Пошаговая инструкция по применению

1) Создайте лист с именем Control в книге и вставьте туда таблицу с именем columnWidths. Таблица должна содержать три столбца: SheetName, ColumnHeader и ColumnWidth. Заполните таблицу строками, в которых укажите имя листа, заголовок столбца (точно как в таблице на листе) и желаемую ширину.

2) Вставьте модуль в проект VBA (Alt+F11 → Insert Module) и скопируйте туда приведённый макрос ResizeColumns. Сохраните книгу как макрос-совместимую (например, xlsm). 3) Запустите макрос ResizeColumns — он применит указанные ширины к соответствующим столбцам на указанных листах.

Дополнительные замечания

Подход с листом Control и таблицей columnWidths делает управление шириной столбцов гибким и удобным. Код не претендует на 100% соответствие вашему сценарию, но он динамически меняет ширины на основании имен листов и заголовков столбцов, что даёт надёжную отправную точку. При необходимости можно расширить таблицу и макрос для дополнительных параметров форматирования.

Ответить

Ваш адрес email не будет опубликован. Обязательные поля помечены *