Есть таблица на листе. У некоторых ячеек уже есть границы разной толщины. Причем, у одной ячейки может быть одна тонкая граница, другая толстая, а остальных нет.
Нужно во всех ячейках выделенного фрагмента уже существующие границы ячеек оставить как есть, а все не прорисованные границы нарисовать одной и той же толщиной.
Как я понимаю - макрос должен проверять каждую ячейку на наличие каждой границы и где той нет - рисовать. Диагональные границы не нужны.
Макрос обрабатывает ячейки выделенного фрагмента.
Макрос
Sub Макрос()
Dim rng As Range, ячейка As Range
Dim i As Long
' Отключаем монитор, чтобы ускорить макрос.
Application.ScreenUpdating = False
'1. Присваиваем выделенному фрагменту имя "rng".
' Может это упростит написание кода.
Set rng = Selection
'2. Если у выделенных ячеек нет границ, то делаем границы сразу у всех ячеек.
If rng.Borders.LineStyle = xlLineStyleNone Then
rng.Borders.LineStyle = 1
rng.Borders.Weight = 1
Exit Sub
End If
'3. Двигаемся по всем ячейкам выделенного фрагмента.
For Each ячейка In rng.Cells
'1) Если у ячейки нет ни одной границы.
If ячейка.Borders.LineStyle = xlLineStyleNone Then
' Делаем сразу все границы у ячейки.
ячейка.Borders.LineStyle = 1
ячейка.Borders.Weight = 1
'2) Если у ячейки есть границы.
Else
' Двигаемся по четырём границам ячейки: лево, верх, низ, право.
For i = 7 To 10
If ячейка.Borders(i).LineStyle = -4142 Then
ячейка.Borders(i).LineStyle = 1
ячейка.Borders(i).Weight = 1
End If
Next i
End If
Next ячейка
End Sub
Спасибо огромное!!! Все работает!!!