Excel工作簿中的动态边框

时间:2018-05-16 21:19:00

标签: vba excel-vba excel

我在工作簿中有50张。表头范围是A:Z。数据范围因工作表而异。我得到了VBA代码,它在非空单元格上设置了边框,但是数据中的某些字段是空白的。有人可以帮助编写脚本吗?

下面是我尝试修改以应用于所有工作表的代码,徒劳无功:

Sub testborder()

    Dim rRng As Range

    Set rRng = Sheet1.Range("A14:K14" & endrow)

    'Clear existing
    rRng.Borders.LineStyle = xlNone

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

使用以下代码解决:

Sub AllWorksheetBorders()

    Application.ScreenUpdating = False    'Prevents screen refreshing
    Dim lngLstCol As Long, lngLstRow As Long, ws As Worksheet
    Dim rngCell As Range, r As Long, c As Long

    For Each ws In ActiveWorkbook.Worksheets
        lngLstRow = ws.UsedRange.Rows.Count
        lngLstCol = ws.UsedRange.Columns.Count

        For Each rngCell In ws.Range("A21:A" & lngLstRow)
            If rngCell.Value <> "" Then
                r = rngCell.Row
                c = rngCell.Column

                With ws.Range(ws.Cells(r, c), ws.Cells(r, lngLstCol)).Borders
                    .LineStyle = xlContinuous    'Setting style of border line
                    .Weight = xlThin    'Setting weight of border line
                    .ColorIndex = xlAutomatic    'Setting colour of border line
                End With
            End If
        Next
    Next

    Application.ScreenUpdating = True    'Enables screen refreshing
End Sub

1 个答案:

答案 0 :(得分:0)

使用以下代码解决:

Sub AllWorksheetBorders()

Application.ScreenUpdating = False    'Prevents screen refreshing
Dim lngLstCol As Long, lngLstRow As Long, ws As Worksheet
Dim rngCell As Range, r As Long, c As Long

For Each ws In ActiveWorkbook.Worksheets
    lngLstRow = ws.UsedRange.Rows.Count
    lngLstCol = ws.UsedRange.Columns.Count

    For Each rngCell In ws.Range("A21:A" & lngLstRow)
        If rngCell.Value <> "" Then
            r = rngCell.Row
            c = rngCell.Column

            With ws.Range(ws.Cells(r, c), ws.Cells(r, lngLstCol)).Borders
                .LineStyle = xlContinuous    'Setting style of border line
                .Weight = xlThin    'Setting weight of border line
                .ColorIndex = xlAutomatic    'Setting colour of border line
            End With
        End If
    Next
Next

Application.ScreenUpdating = True    'Enables screen refreshing

End Sub