Макрос VBA для Excel: автоматически подогнать ширину столбцов по заголовкам

Изменение ширины колонок в Excel по заголовкам через VBA (без Autofit)

Задача: задать разные ширины для 26 колонок на листе по их заголовкам (не автоподбором), причём колонки могут перемещаться — нужно определять их по заголовкам в шапке.

Проблема кратко и типичная ошибка

Часто пытаются задать ширины «вручную» многими вызовами Offset/Resize, привязав всё к конкретной области. Такой код работает громоздко и легко даёт ошибки (например, «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

Практическое и гибкое решение — таблица управления + макрос

Лучший и наиболее поддерживаемый вариант — хранить соответствие «лист — заголовок — ширина» в отдельной таблице и запускать макрос, который считывает эту таблицу и для каждой записи ищет заголовок в первой строке целевого листа и устанавливает ширину найденной колонки.

Плюсы такого подхода:

  • Не нужен править код при изменении ширин или добавлении новых столбцов — достаточно обновить таблицу.
  • Работает даже если столбцы поменяли порядок (поиск по заголовку).
  • Можно централизованно управлять настройками для нескольких листов.

Шаги для настройки

  1. Создайте лист с именем Control.
  2. На нём создайте таблицу (Insert → Table) с тремя колонками: SheetName, ColumnHeader, ColumnWidth.
  3. Дайте таблице имя columnWidths (через Table Design → Table Name).
  4. Заполните таблицу нужными строками: имя листа, текст заголовка (как в первой строке листа), желаемая ширина (число).
  5. Добавьте в проект VBA новый модуль и вставьте предложенный ниже код.
  6. Запустите процедуру ResizeColumns — она применит ширины ко всем записям таблицы.

Код макроса (оставлен без изменений):

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

Пояснение работы кода

  • Считывается таблица columnWidths с листа Control по строкам.
  • Для каждой строки извлекаются: sheetName (куда применить), columnName (текст заголовка), colWidth (значение ширины).
  • Через Application.Match ищется позиция заголовка в первой строке целевого листа (ws.Rows(1)). Match возвращает номер колонки (первое совпадение).
  • Если заголовок найден, задаётся ws.Columns(columnIndex).ColumnWidth = colWidth.
  • Если заголовок не найден — выводится сообщение в окно Immediate (Debug.Print), но выполнение продолжается.

Варианты решения и рекомендации, когда что лучше

Вариант 1 — таблица управления + макрос (рекомендую):

  • Подходит для множества листов, гибкого управления, когда заголовки могут перемещаться.
  • Удобно для пользователей, не знакомых с VBA — им достаточно редактировать таблицу.

Вариант 2 — статический код с массивом заголовков и массивом ширин (быстрее для одного фиксированного листа):

  • Можно задать массив заголовков и параллельный массив ширин и в коде пройтись по массивам, искать заголовок на листе и задавать ширину.
  • Подходит если у вас один лист и структура редко меняется — но для поддержки и масштабирования уступает таблице.

Вариант 3 — жёсткая привязка по индексам (не рекомендую):

  • Привязка к конкретным индексам колонок (A,B,C и т.д.) ломается при изменении порядка столбцов и менее удобна в сопровождении.

Практические советы и подводные камни

  • Имена листов и текста заголовков в таблице управления должны совпадать с реальными (Match нечувствителен к регистру, но точные строки важны).
  • Если строк в таблице много и производительность критична — можно сгруппировать изменения по листам и применять их пачками.
  • Код предполагает, что лист с именем в таблице существует — если нет, процедура выдаст ошибку. При необходимости добавьте проверку существования листа перед Set ws = …
  • Если заголовков с одинаковым именем несколько — Match вернёт позицию первого совпадения.

Выводы и рекомендации

  • Для управляемого, масштабируемого и простого в поддержке решения используйте таблицу управления (Control → columnWidths) и макрос, который ищет заголовки и задаёт ширину — этот подход наиболее гибкий и удобный для бизнеса.
  • Если у вас простой и стабильный набор колонок (один лист, порядок не меняется), можно упростить логику и использовать массивы или фиксированные индексы, но это менее удобно при изменениях.
  • Перед запуском макроса проверьте, что названия листов и заголовков правильно внесены в таблицу, и что таблица действительно называется columnWidths.

Если хотите, могу показать пример кода варианта с массивом заголовков и массивом ширин или подобрать защиту/обработку ошибок для текущего макроса.

Ответить

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