Добрый день дамы и господа Помощи прошу в проставлении простой границы между ячейкой A19 и до столбца К, содержащего в ячейке A20 и ниже слово "Составил:" (на одну ячейку выше). Или между ячейкой столбца, содержащего "1" (в примере это А18) и до столбца К, содержащего в ячейке A20 и ниже слово "Составил:" (на одну ячейку выше).
Добрый день дамы и господа Помощи прошу в проставлении простой границы между ячейкой A19 и до столбца К, содержащего в ячейке A20 и ниже слово "Составил:" (на одну ячейку выше). Или между ячейкой столбца, содержащего "1" (в примере это А18) и до столбца К, содержащего в ячейке A20 и ниже слово "Составил:" (на одну ячейку выше).
Спасибо. Хороший вариант, но хочется в один клик, как для абсолютных лентяев версия. Если возможно (поиск пользовал, сам пытался преобразовать код подставляющий формулу от заданной ячейки до содержащей текст). Как найти слово в ячейке знаю, как выделить диапазон тоже, а вот потом как потом натянуть на выделенное границу...
Спасибо. Хороший вариант, но хочется в один клик, как для абсолютных лентяев версия. Если возможно (поиск пользовал, сам пытался преобразовать код подставляющий формулу от заданной ячейки до содержащей текст). Как найти слово в ячейке знаю, как выделить диапазон тоже, а вот потом как потом натянуть на выделенное границу...timo64uk
Сообщение отредактировал timo64uk - Вторник, 15.02.2022, 15:53
На просторах нашел творение от Boroda, пытался адаптировать но перед With не знаю что ставить - как на ActiveSheet сослаться ноунейм.
[vba]
Код
With Range("A19:K9999") .Borders.LineStyle = xlNone End With With .Range("A19:K" & Range("L" & Rows.Count).End(xlUp).Row) 'от А19 до последней заполненной в столбце "L" (перед Range удалил точку) .Borders.LineStyle = xlContinuous End With
[/vba]
На просторах нашел творение от Boroda, пытался адаптировать но перед With не знаю что ставить - как на ActiveSheet сослаться ноунейм.
[vba]
Код
With Range("A19:K9999") .Borders.LineStyle = xlNone End With With .Range("A19:K" & Range("L" & Rows.Count).End(xlUp).Row) 'от А19 до последней заполненной в столбце "L" (перед Range удалил точку) .Borders.LineStyle = xlContinuous End With
Нашел решение без поиска "Составил:", но до пустого в столбце L : [vba]
Код
Dim iRange As Range Dim iCells As Range 'Set iRange = Range("A18:L18") 'конкретный массив Set iRange = Range("A18:K" & Range("L" & Rows.Count).End(xlUp).Row) For Each iCells In iRange iCells.BorderAround _ LineStyle:=xlContinuous, _ Weight:=xlThin Next iCells
[/vba]
Нашел решение без поиска "Составил:", но до пустого в столбце L : [vba]
Код
Dim iRange As Range Dim iCells As Range 'Set iRange = Range("A18:L18") 'конкретный массив Set iRange = Range("A18:K" & Range("L" & Rows.Count).End(xlUp).Row) For Each iCells In iRange iCells.BorderAround _ LineStyle:=xlContinuous, _ Weight:=xlThin Next iCells
Sub u_745() a = Application.Match("Составил:", Range("a:a"), 0) - 1 With Range("a19:k" & a) .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlInsideVertical).LineStyle = xlContinuous .Borders(xlInsideHorizontal).LineStyle = xlContinuous End With End Sub
[/vba]
[vba]
Код
Sub u_745() a = Application.Match("Составил:", Range("a:a"), 0) - 1 With Range("a19:k" & a) .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlInsideVertical).LineStyle = xlContinuous .Borders(xlInsideHorizontal).LineStyle = xlContinuous End With End Sub
Sub iBorders() Dim FoundCell As Range Dim Row_Resurs As Long Dim Row_Sostavil As Long Set FoundCell = Columns("B").Find("Наименование ресурса", , xlValues, xlWhole) If Not FoundCell Is Nothing Then Row_Resurs = FoundCell.Row End If Set FoundCell = Nothing Set FoundCell = Columns("A").Find("Составил:", , xlValues, xlWhole) If Not FoundCell Is Nothing Then Row_Sostavil = FoundCell.Row End If Set FoundCell = Nothing Range(Cells(Row_Resurs + 1, "A"), Cells(Row_Sostavil - 1, "K")).Borders.Weight = xlThin End Sub
[/vba]
[vba]
Код
Sub iBorders() Dim FoundCell As Range Dim Row_Resurs As Long Dim Row_Sostavil As Long Set FoundCell = Columns("B").Find("Наименование ресурса", , xlValues, xlWhole) If Not FoundCell Is Nothing Then Row_Resurs = FoundCell.Row End If Set FoundCell = Nothing Set FoundCell = Columns("A").Find("Составил:", , xlValues, xlWhole) If Not FoundCell Is Nothing Then Row_Sostavil = FoundCell.Row End If Set FoundCell = Nothing Range(Cells(Row_Resurs + 1, "A"), Cells(Row_Sostavil - 1, "K")).Borders.Weight = xlThin End Sub