在已用单元格范围 VBA 中应用边框

Question

我正在尝试在一组使用过的单元格周围动态应用边框。 column Range is (B7:E7) rows number will always vary, 所以代码需要是动态的。我下面的代码没有实现这个：

Sub Borders()

Application.ScreenUpdating = False
Dim lngLstCol As Long, lngLstRow As Long

lngLstRow = ActiveSheet.UsedRange.Rows.Count
lngLstCol = ActiveSheet.UsedRange.Columns.Count

For Each rngCell In Range("B7:B" & lngLstRow)
    If rngCell.Value > "" Then
        r = rngCell.row
        c = rngCell.Column
        Range(Cells(r, c), Cells(r, lngLstCol)).Select
            With Selection.Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
    End If
Next

Application.ScreenUpdating = True

End Sub

Answer 1

此代码为 B7 以外的所有非空单元格设置了边框。

Sub Borders()

    Application.ScreenUpdating = False

    Dim lngLstCol As Long, lngLstRow As Long

    lngLstRow = ActiveSheet.UsedRange.Rows.Count
    lngLstCol = ActiveSheet.UsedRange.Columns.Count

    For Each rngCell In Range(Range("B7"), Cells(lngLstRow, lngLstCol))
        If rngCell.Value > "" Then
            rngCell.Select 'Select cells
            With Selection.Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
        End If
    Next

    Application.ScreenUpdating = True

End Sub

下面的代码在超出 B7:

的使用范围周围放置了边框

Sub BordersB()

    Application.ScreenUpdating = False

    Dim lngLstCol As Long, lngLstRow As Long

    lngLstRow = ActiveSheet.UsedRange.Rows.Count
    lngLstCol = ActiveSheet.UsedRange.Columns.Count

    With Range(Range("B7"), Cells(lngLstRow, 2)).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With

    With Range(Range("B7"), Cells(7, lngLstCol)).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With

    With Range(Cells(7, lngLstCol), Cells(lngLstRow, lngLstCol)).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With

    With Range(Cells(lngLstRow, 2), Cells(lngLstRow, lngLstCol)).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With

    Application.ScreenUpdating = True

End Sub

Answer 2

这将为列 (B:C) 中第 6 行下方的所有 none 空白单元格添加边框

    Sub AddBorders()
    Dim Rws As Long, Rng As Range, c As Range

    Rws = Range("A1").SpecialCells(xlCellTypeLastCell).Row
    Set Rng = Range(Cells(7, "B"), Cells(Rws, "C"))

    For Each c In Rng.Cells

        If c <> "" Then

            With c.Borders

                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic

            End With

        End If

    Next c

End Sub

在已用单元格范围 VBA 中应用边框

Apply borders in a used cell Range VBA

vba

loops

excel

border