Границы указанного диапазона и листов - PullRequest
0 голосов
/ 29 мая 2018

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

Sub Borders()

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
Dim skp As Boolean

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

    For Each rngCell In ws.Range("A1: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

Как использовать этот код, чтобы игнорировать первый лист и применять границы только к листам после этого?

Ответы [ 2 ]

0 голосов
/ 29 мая 2018
Sub Borders()
    Dim ws As Worksheet, row As Range

    For Each ws In Worksheets
        If ws.Name <> "Sheet1" Then      ' replace Sheet1 with the name of the Sheet to skip
            For Each row In ws.UsedRange.Rows
                If row(1) <> "" Then row.Borders.LineStyle = xlContinuous    
            Next
        End If
    Next
End Sub
0 голосов
/ 29 мая 2018

Просто прокрутите листы по индексу, начиная с 2.

Примечание: пользователь может переупорядочить листы, поэтому «первый лист» может оказаться не тем, который вы ожидаете

Этот код также учитывает возможные типы листов, отличные от Worksheet

Sub Demo()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim idx As Long

    Set wb = ActiveWorkbook
    For idx = 2 To wb.Sheets.Count
        If wb.Sheets(idx).Type = xlWorksheet Then
            Set ws = wb.Sheets(idx)
            With ws
                'all your ws code ...
            End With
        End If
    Next

End Sub

. Чтобы справиться с возможностью перемещения листов пользователем, вы можете использовать листы с кодовым именем

* 1011.* В этом коде SheetX - это кодовое название листа, который вы не хотите форматировать (измените его в соответствии со своими потребностями)
Sub Demo()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim idx As Long

    Set wb = ActiveWorkbook
    For idx = 1 To wb.Sheets.Count
        If wb.Sheets(idx).Type = xlWorksheet Then
            If Not wb.Sheets(idx) Is SheetX Then
                Set ws = wb.Sheets(idx)
                With ws
                    'all your ws code ...
                End With
            End If
        End If
    Next

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...