Код VBA для размещения границ вокруг объединенных диапазонов ячеек в динамическом листе

Question

Я строю динамический прайс лист для отправки клиентам. Я настроил его, чтобы скрывать / показывать разные продукты, а затем объединять ячейки «Семейство продуктов», чтобы их было легче читать. Все работает, кроме попыток динамического выделения всей строки, чтобы создать толстую рамку вокруг каждого «семейства продуктов». Они изменятся и будут зависеть от других выборов, поэтому я не могу просто указать диапазоны (как показала бы запись макроса).

Используя цикл «Для каждого», я могу получить лист, который, казалось бы, делает правильные выборы, однако, Я не могу получить .Border Вокруг всего поля, он также помещает толстые линии во внутренние строки.

Пример таблицы данных

Private Sub CommandButton1_Click()
'find last row before merge
Dim lastrow As Long
  lastrow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row

'Merge Cells
  Application.DisplayAlerts = False

Dim rng As Range
MergeCells1:
For Each rng In Sheet1.Range("B2:E20")
  If rng.Value = rng.Offset(1, 0).Value And rng.Value <> "" Then
    Range(rng, rng.Offset(1, 0)).Merge
    Range(rng, rng.Offset(1, 0)).HorizontalAlignment = xlCenter
    Range(rng, rng.Offset(1, 0)).VerticalAlignment = xlCenter
    GoTo MergeCells1
  End If
Next

'Borders
With Sheet1.Range("B1:E" & lastrow)
  .Borders.LineStyle = xlContinuous 'all gridlines
  .BorderAround Weight:=xlThick 'thick border around whole table
End With

'*****Here's the Problem!!!******
'Borders around each Year set.
'Trying to put a border around this selection:
Dim yr As Range
For Each yr In Sheet1.Range("B2:B" & lastrow)
  With Sheet1
    .Range(.Cells(yr.Row, "B"), .Cells(yr.Row, "E")).Select
  End With
Next

'If i replace .Select with .BorderAround it puts a borderaround each line.
For Each yr In Sheet1.Range("B2:B" & lastrow)
  With Sheet1
    .Range(.Cells(yr.Row, "B"), .Cells(yr.Row, "E")).BorderAround Weight:=xlThick
  End With
Next

End Sub

Данные начинаются в столбцеB. Столбец A используется для обозначения того, какие строки включены в полный код.

Выполнение кода выделит правильный выбор, но подчеркнет каждую строку. Ищем толстую рамку вокруг каждого "блока года"

Спасибо за любую помощь!

Answer 1

Это выход, который вы искали?

Вместо того, чтобы использовать .BorderAround, я использовал .Borders(xlEdgeTop), чтобы получить тот же эффект, так как у вас уже есть граница вокруг ваших данных.
Этот код смотрит, где столбец года объединяется, и каждый раз, когда наступает новый год, добавляется верхняя граница.
Я знаю, что это не совсем то, что вы искали, но он получаетдело сделано? :)

Sub TESTING()
'Testing code for the following question:
'/12927871/kod-vba-dlya-razmescheniya-granits-vokrug-obedinennyh-diapazonov-yacheek-v-dinamicheskom-liste
Dim lastrow As Long
Dim ws As Worksheet
Dim rng As Range

Set ws = Worksheets("TEST_SHEET")
lastrow = ws.Cells(Rows.Count, 2).End(xlUp).Row

Application.DisplayAlerts = False

'Merge Cells:
MergeCells1:
For Each rng In ws.Range("B2:E20")
    If rng.Value = rng.Offset(1, 0).Value And rng.Value <> "" Then
        Range(rng, rng.Offset(1, 0)).Merge
        Range(rng, rng.Offset(1, 0)).HorizontalAlignment = xlCenter
        Range(rng, rng.Offset(1, 0)).VerticalAlignment = xlCenter
        GoTo MergeCells1
    End If
Next

With ws.Range("B1:E" & lastrow)
    .Borders.LineStyle = xlContinuous
    .BorderAround Weight:=xlThick
End With

For Each yr In ws.Range("B2:B" & lastrow)
    If yr.Value <> "" Then
        With ws.Range(yr, yr.Offset(0, 3)).Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThick
        End With
    End If
Next

End Sub