Обрамление ячеек по условию

@ooos · Регистрация: 08.04.2021

Студворк — интернет-сервис помощи студентам

Есть макрос обрамления ячеек диапазона по условию.
Как скорректировать код, чтобы обрамлялись все ячейки строки диапазона, если в строке диапазона есть непустая ячейка?

Visual Basic
1
2
3
4
5
6
7
8
9
Sub ApplyBorderIfCellIsFilled()
    Dim rng As Range
       Set rng = Range("A1:I77")
        For Each cell In rng
            If cell.Value <> "" Then
                cell.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
            End If
        Next cell
End Sub

@elixi · 05.06.2025, 02:26

Сообщение от ooos

Как скорректировать код, чтобы обрамлялись все ячейки строки диапазона, если в строке диапазона есть непустая ячейка?

например так

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Test()
    Dim rng As Range
    Dim R&, R1&, Rn&, C&, C1&, Cn&
    
    Set rng = Range("A1:I77")
 
    R1 = rng.Row:    Rn = rng.Rows.Count + R1 - 1
    C1 = rng.Column: Cn = rng.Columns.Count + C1 - 1
    
    For R = R1 To Rn
    For C = C1 To Cn
        If Cells(R, C) <> "" Then
            Intersect(Rows(R), rng).BorderAround _
                LineStyle:=xlContinuous, Weight:=xlThin
            Exit For
        End If
    Next
    Next
End Sub

@ooos · 05.06.2025, 02:42 **[ТС]**

elixi, а возможен вариант применения ко всем внутренним границам ячеек?

@elixi · 05.06.2025, 19:15

Сообщение от ooos

elixi, а возможен вариант применения ко всем внутренним границам ячеек?

ooos, возможно всякое, по вашему вкусу обрамлять и окрашивать.
Запускайте макрорекордер, обрамляйте и потом из кода выбирайте подходяшее вам.
В предыдущем примере я оставил то что у Вас было. Но можно и по другому:

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Test()
    Dim rng As Range
    Dim R&, R1&, Rn&, C&, C1&, Cn&
 
    Set rng = Range("A1:I77")
 
    R1 = rng.Row:    Rn = rng.Rows.Count + R1 - 1
    C1 = rng.Column: Cn = rng.Columns.Count + C1 - 1
    
    For R = R1 To Rn
    For C = C1 To Cn
        If Cells(R, C) <> "" Then
            With Intersect(Rows(R), rng)
                .Borders.LineStyle = xlContinuous
                .Borders.Weight = xlThin
                .Interior.Color = 5296274
            End With
            Exit For
        End If
    Next
    Next
End Sub

@ooos · 05.06.2025, 20:15 **[ТС]**

elixi, Большое спасибо за отличное Решение, но попытаюсь спросить: как изменить код, чтобы строки таблицы A2:I77 (заголовок оставим как есть)
красились черезстрочно .Interior.Color = RGB(232, 232, 232) для придания стиля таблице, или это уже off topic?

@Апострофф · 05.06.2025, 20:44

ooos, Главная -> Форматировать как таблицу...

@ooos · 05.06.2025, 20:47 **[ТС]**

Сообщение от Апострофф

Главная -> Форматировать как таблицу...

не надо форматировать, надо сделать вид

@elixi · 05.06.2025, 22:26

Сообщение от ooos

или это уже off topic?

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

Сообщение от ooos

не надо форматировать, надо сделать вид

а зачем делать вид если можно использовать то что уже есть в наличии?

@ooos · 06.06.2025, 23:24 **[ТС]**

Сообщение от elixi

а зачем делать вид если можно использовать то что уже есть в наличии?

Закрою гештальт:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 Dim R&, R1&, Rn&, c&, C1&, Cn&
    Set rng = Range("A2:I77")
    R1 = rng.Row: Rn = rng.Rows.Count + R1 - 1
    C1 = rng.Column: Cn = rng.Columns.Count + C1 - 1
   
    For R = R1 To Rn      
        If Application.WorksheetFunction.CountA(Rows(R)) > 0 Then          
            With Intersect(Rows(R), rng)
                .Borders.LineStyle = xlContinuous
                .Borders.Weight = xlThin
            End With            
            If R Mod 2 <> 0 Then
                With Intersect(Rows(R), rng)
                    .Interior.Color = RGB(232, 232, 232)
                End With
            End If
        End If
    Next R

Новые блоги и статьи Все статьи Все блоги /
Модель заражения группы наркоманов alhaos 17.04.2026 Условия задачи сформулированы тут Суть: - Группа наркоманов из 10 человек. - Только один инфицирован ВИЧ. - Колются одной иглой. - Колются раз в день. - Колются последовательно через. . .	Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.
Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .	Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .	Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .

@ooos 9 / 9 / 0 Регистрация: 08.04.2021 Сообщений: 297
	05.06.2025, 02:42 [ТС]
	elixi, а возможен вариант применения ко всем внутренним границам ячеек? 0

@ooos 9 / 9 / 0 Регистрация: 08.04.2021 Сообщений: 297
	05.06.2025, 20:15 [ТС]
	elixi, Большое спасибо за отличное Решение, но попытаюсь спросить: как изменить код, чтобы строки таблицы A2:I77 (заголовок оставим как есть) красились черезстрочно .Interior.Color = RGB(232, 232, 232) для придания стиля таблице, или это уже off topic? 0

@Апострофф 9908 / 3928 / 742 Регистрация: 11.10.2011 Сообщений: 5,908
	05.06.2025, 20:44
	ooos, Главная -> Форматировать как таблицу... 0