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

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

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

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
 CustomX29 окт. 2012 г., 14:33
Я отредактировал свой заголовок так, как будто он смущал людей

Ответы на вопрос(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
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

которые я добавляю в каждую книгу 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
Решение Вопроса

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

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

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

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

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

 CustomX29 окт. 2012 г., 14:22
ИДК, это то, что вы ничего не создали в моем исходном коде.
 CustomX29 окт. 2012 г., 14:00
Не очень помогает, это будет работать на диапазоне, но не на ячейку.
 Sylca29 окт. 2012 г., 14:15
и что именно это: Range ("C11"). Borders (xlEdgeRight) .LineStyle = xlContinuous или this: Range ("A15: A15"). Borders (xlEdgeBottom) .LineStyle = xlContinuous

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))

Вот еще один способ

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

Ваш ответ на вопрос