Автоматичне додавання межі в Excel одразу після заповнення комірки

Є два способи зробити так, щоб Excel автоматично встановлював межу після заповнення комірки:

1. За допомогою умовного форматування.
2. За допомогою 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