Применить границы к отдельным невидимым ячейкам таблиц

[Niyetkhan]

Доброго времени суток!

Не могу решить следующую проблему:

На одном листе расположено большое количество таблиц (около 500), одна под другой. Таблицы разделены строками с Названиями этих таблиц (границы ячеек с Названиями таблиц не видимы, и не должны быть видимыми).

Количество столбцов в этих таблицах разное, может отличаться.

В некоторых таблицах встречаются 2-3 ячейки, у которых Нет границ (не видимы).

Теперь стоит задача:
1) применить границы к этим ячейкам, т.е. сделать их видимыми.
2) сделать это во всех таблицах на листе.

Для наглядности прилагаю файл с первыми двумя таблицами, ячейки без границ окрашены в желтый цвет.

Остальные 498 таблиц не стал выгружать, т.к. занимает много места.

Думаю, что нужен макрос.
Но т.к. я не силен в VBA, прошу вашей помощи…

Буду очень признателен за отклики и советы.

С уважением,
Ниетхан

[Niyetkhan]

Нужно также сделать видимыми также и пустые ячейки в этих таблицах - ячейки без значений, у которых нет границ

[Niyetkhan]

Прилагаю рисунок для примера того, что должно быть в результате

[macomics]

Понимаю. Лень двигатель прогресса. Но в Excel есть такая тема как специальная вставка.

Выделили все столбцы и применили ко всем ячейкам стиль нужных границ.
Отредактировали заголовок и при помощи специальной вставки скопировали формат ячеек в остальные пробелы между таблицами. 500 - не такое и большое число операций. Дольше макрос писать будете. За пару часов уже бы отредактировали всю таблицу.

[jillitil]

Никаких проверок и защит от дурака. Макрос зарисует тот документ, который вы дали.

Sub Макрос3()
    Range("A65536").Select
    Selection.End(xlUp).Select
    While ActiveCell.Row > 1
        Range(Selection, Selection.End(xlUp)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        НарисоватьГраницыТаблицы
        ActiveCell.Select
        Selection.End(xlUp).End(xlUp).End(xlUp).Select
    Wend
End Sub


Sub НарисоватьГраницыТаблицы()
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    For Each V In Array(9, 7, 10, 8, 11, 12)
        With Selection.Borders(V)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    Next
End Sub

[Niyetkhan]

Запустил макрос, но почему-то все осталось так, как было.

[Niyetkhan]

Прилагаю файл с результатом

[Niyetkhan]

В общем, во всех таблицах все ячейки должны быть с границами, видимыми. Включая первый столбец. Там тоже встречается.

[jillitil]

Первый столбец "наименование" должен быть без пустых ячеек.

Sub Макрос4()
    Dim DL As Range
    
    Range("A65536").Select
    Selection.End(xlUp).Select
    StartRow = ActiveCell.Row
    While ActiveCell.Row > 1
        Application.StatusBar = "Готово на: " & Round(100 * (1 - ActiveCell.Row / StartRow), 3) & "%"
        DoEvents
        Set DL = ActiveCell
        
        ActiveCell.End(xlUp).Offset(-1, 0).End(xlToRight).Select
        ActiveCell.Offset(1, 0).End(xlToRight).Offset(-1, 0).Select
        Range(Selection, DL).Select
        
        НарисоватьГраницыТаблицы
        DL.End(xlUp).End(xlUp).End(xlUp).End(xlUp).Select
    Wend
    Application.StatusBar = ""
End Sub

Sub НарисоватьГраницыТаблицы()
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    For Each V In Array(9, 7, 10, 8, 11, 12)
        With Selection.Borders(V)
            .LineStyle = xlContinuous
            .Weight = xlMedium  'xlThin
            .ColorIndex = 5 'xlAutomatic
        End With
    Next
End Sub

[Niyetkhan]

Спасибо Вам огромное !!!

Все работает так, как было задумано.
Еще раз благодарю Вас!

С уважением, Ниетхан