Граница вокруг каждой ячейки в диапазоне

Я пытаюсь создать простую функцию, которая добавит границы вокруг каждой ячейки в определенном диапазоне. Используя замечательную запись, это генерирует тонну кода, который совершенно бесполезен. В приведенном ниже коде будет отображаться "таблица" данных, вокруг каждой ячейки этого диапазона я хотел бы добавить границу. В Интернете я не смог найти простой или понятный ответ для этого.

Вся помощь очень ценится!

Set DT = Sheets("DATA")
endRow = DT.Range("F" & Rows.Count).End(xlUp).Row
result = 3

For I = 2 To endRow
    If DT.Cells(I, 6).Value = Range("B1").Value Then
        Range("A" & result) = DT.Cells(I, 6).Value
        Range("B" & result) = DT.Cells(I, 1).Value
        Range("C" & result) = DT.Cells(I, 24).Value
        Range("D" & result) = DT.Cells(I, 37).Value
        Range("E" & result) = DT.Cells(I, 3).Value
        Range("F" & result) = DT.Cells(I, 15).Value
        Range("G" & result) = DT.Cells(I, 12).Value
        Range("H" & result) = DT.Cells(I, 40).Value
        Range("I" & result) = DT.Cells(I, 23).Value
        result = result + 1
    End If
Next I

Ответы

Ответ 1

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

Range("A1:F20").Borders.LineStyle = xlContinuous

Также легко применить несколько эффектов к границе вокруг каждой ячейки.

Например:

Sub RedOutlineCells()
    Dim rng As Range

    Set rng = Range("A1:F20")

    With rng.Borders
        .LineStyle = xlContinuous
        .Color = vbRed
        .Weight = xlThin
    End With
End Sub

Ответ 2

В качестве параметра можно вызвать следующий параметр:

Option Explicit

Sub SetRangeBorder(poRng As Range)
    If Not poRng Is Nothing Then
        poRng.Borders(xlDiagonalDown).LineStyle = xlNone
        poRng.Borders(xlDiagonalUp).LineStyle = xlNone
        poRng.Borders(xlEdgeLeft).LineStyle = xlContinuous
        poRng.Borders(xlEdgeTop).LineStyle = xlContinuous
        poRng.Borders(xlEdgeBottom).LineStyle = xlContinuous
        poRng.Borders(xlEdgeRight).LineStyle = xlContinuous
        poRng.Borders(xlInsideVertical).LineStyle = xlContinuous
        poRng.Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End If
End Sub

Примеры:

Call SetRangeBorder(Range("C11"))
Call SetRangeBorder(Range("A" & result))
Call SetRangeBorder(DT.Cells(I, 6))
Call SetRangeBorder(Range("A3:I" & endRow))

Ответ 3

Здесь другой путь

Sub testborder()

    Dim rRng As Range

    Set rRng = Sheet1.Range("B2:D5")

    'Clear existing
    rRng.Borders.LineStyle = xlNone

    'Apply new borders
    rRng.BorderAround xlContinuous
    rRng.Borders(xlInsideHorizontal).LineStyle = xlContinuous
    rRng.Borders(xlInsideVertical).LineStyle = xlContinuous

End Sub

Ответ 4

У меня есть набор из 15 подпрограмм, которые я добавляю в каждую книгу Coded Excel, которую я создаю, и это одна из них. Следующая процедура очищает область и создает границу.

Образец звонка:

Call BoxIt(Range("A1:z25"))

Подпрограмма:

Sub BoxIt(aRng As Range)
On Error Resume Next

    With aRng

        'Clear existing
        .Borders.LineStyle = xlNone

        'Apply new borders
        .BorderAround xlContinuous, xlThick, 0
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .Weight = xlMedium
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .Weight = xlMedium
        End With
    End With

End Sub

Ответ 5

Для добавления границ попробуйте это, например:

Range("C11").Borders(xlEdgeRight).LineStyle = xlContinuous
Range("A15:D15").Borders(xlEdgeBottom).LineStyle = xlContinuous

Надеюсь, что синтаксис правильный, потому что я сделал это на С#.

Ответ 6

xlWorkSheet.Cells(1, 1).Borders(Excel.XlBordersIndex.xlEdgeRight).LineStyle = Excel.XlDataBarBorderType.xlDataBarBorderSolid
xlWorkSheet.Cells(1, 1).Borders(Excel.XlBordersIndex.xlEdgeLeft).LineStyle = Excel.XlDataBarBorderType.xlDataBarBorderSolid
xlWorkSheet.Cells(1, 1).Borders(Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlDataBarBorderType.xlDataBarBorderSolid
xlWorkSheet.Cells(1, 1).Borders(Excel.XlBordersIndex.xlEdgeTop).LineStyle = Excel.XlDataBarBorderType.xlDataBarBorderSolid

Ответ 7

Вы также можете включить эту задачу в другой макрос, не открывая новый:

Я не ставлю Sub и заканчиваю Sub, потому что макрос содержит гораздо более длинный код, как показано на рисунке ниже.

With Sheets("1_PL").Range("EF1631:JJ1897")
    With .Borders
    .LineStyle = xlContinuous
    .Color = vbBlack
    .Weight = xlThin
    End With
[![enter image description here][1]][1]End With