Автоматическое добавление границ в Excel сразу после заполнения ячейки

Есть два способа сделать так, чтобы Excel автоматически устанавливал границу после заполнения ячейки:

1. При помощи условного форматирования.
2. C помощью VBA.

Автоматическое добавление границы ячейки Excel с помощью условного форматирования

1. Выделите область, в которую будут вводиться данные.
2. На вкладке «Главная» нажмите «Условное форматирование».
3. Выберите «Создать правило».
4. В окне «Создание правила форматирования» выберите «Использовать формулу для определения форматируемых ячеек».
5. В поле «Форматировать значение для которых следующая формула является истиной» введите следующую формулу: =$ячейка_с_которой_начинать<>"" (Например, =$B2<>"").
6. Нажмите «Формат…».
7. В окне «Формат ячеек» перейдите на вкладку «Граница».
8. Выберите «Тип линии» и активируйте параметр «Внешние».
9. Нажмите OK.

Теперь, когда вы будете вводить данные в ячейки того столбца, который указали в формуле, то для них автоматически будет устанавливаться граница.

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

Автоматическое добавление границы ячейки Excel с помощью VBA

1. Откройте Excel и нажмите Alt+F11, чтобы перейти в редактор Visual Basic for Applications (VBA).
2. В редакторе VBA в окне Project Explorer выберите свой рабочий лист. Обычно он называется «Sheet1 (Лист1)» или что-то подобное.
3. Дважды щёлкните имя листа, чтобы открыть его код. Или сделайте клик правой кнопкой мыши по «Sheet1 (Лист1)» и выберите «View Code».
4. Вставьте код VBA в окно кода листа.
5. Сохраните книгу Excel с поддержкой макросов.

Код VBA для автоматического добавления границы ячеек Excel

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Проверяем, изменил ли пользователь значение в ячейке и не пуста ли ячейка
    If Not Intersect(Target, Me.UsedRange) Is Nothing And Not IsEmpty(Target.Value) Then
        ' Проверяем, не находится ли ячейка в первой строке
        If Target.Row > 1 Then
            Dim startCell As Range
            Dim endCell As Range
            Dim cellAbove As Range
            Dim rng As Range
            Dim i As Integer
            
            ' Находим начальную ячейку группы (влево)
            Set startCell = Target
            For i = Target.Column To 1 Step -1
                If Cells(Target.Row - 1, i).Borders(xlEdgeBottom).LineStyle <> xlNone Then
                    Set startCell = Cells(Target.Row, i)
                Else
                    Exit For
                End If
            Next i
            
            ' Находим конечную ячейку группы (вправо)
            Set endCell = Target
            For i = Target.Column To Me.Columns.Count
                If Cells(Target.Row - 1, i).Borders(xlEdgeBottom).LineStyle <> xlNone Then
                    Set endCell = Cells(Target.Row, i)
                Else
                    Exit For
                End If
            Next i
            
            ' Проходим по всем ячейкам в определённом диапазоне
            For Each rng In Me.Range(startCell, endCell).Cells
                ' Визначаємо комірку над поточною
                Set cellAbove = rng.Offset(-1, 0)

                ' Если у ячейки над текущей есть нижняя граница, то копируем все границы
                If cellAbove.Borders(xlEdgeBottom).LineStyle <> xlNone Then
                    rng.Borders(xlEdgeTop).LineStyle = cellAbove.Borders(xlEdgeTop).LineStyle
                    rng.Borders(xlEdgeTop).Color = cellAbove.Borders(xlEdgeTop).Color
                    rng.Borders(xlEdgeTop).Weight = cellAbove.Borders(xlEdgeTop).Weight

                    rng.Borders(xlEdgeBottom).LineStyle = cellAbove.Borders(xlEdgeBottom).LineStyle
                    rng.Borders(xlEdgeBottom).Color = cellAbove.Borders(xlEdgeBottom).Color
                    rng.Borders(xlEdgeBottom).Weight = cellAbove.Borders(xlEdgeBottom).Weight
                    
                    rng.Borders(xlEdgeLeft).LineStyle = cellAbove.Borders(xlEdgeLeft).LineStyle
                    rng.Borders(xlEdgeLeft).Color = cellAbove.Borders(xlEdgeLeft).Color
                    rng.Borders(xlEdgeLeft).Weight = cellAbove.Borders(xlEdgeLeft).Weight
                    
                    rng.Borders(xlEdgeRight).LineStyle = cellAbove.Borders(xlEdgeRight).LineStyle
                    rng.Borders(xlEdgeRight).Color = cellAbove.Borders(xlEdgeRight).Color
                    rng.Borders(xlEdgeRight).Weight = cellAbove.Borders(xlEdgeRight).Weight
                End If
            Next rng
        End If
    End If
End Sub

Видео: Автоматическое добавление внешней границы ячеек в Excel