Делая все oop от 1 до LastRow

Question

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

Если ячейка в столбце Q содержит 1, то она добавляет строку с определенной разметкой. Теперь код переходит с Q3276 на Q8, как мне изменить процесс? Предпочтительно, я хочу, чтобы l oop до go с Q8 до Q LastRow. Также, если у кого-то есть более простой способ написания кода, пожалуйста, дайте мне знать.

Dim rngc As Range, rc As Long

Set rngc = Range("Q8:Q3276")

For rc = rngc.Count To 1 Step -1
    If rngc(rc).Value = 1 Then
        rngc(rc + 1).EntireRow.Insert
        rngc(rc + 1).EntireRow.Select

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A35").Select

    End If
Next rc

Answer 1

Предпочтительно, я хочу, чтобы l oop до go от Q8 до Q LastRow.

Чтобы полностью изменить oop, вы можете использовать For rc = 1 to rngc.Count. Обратите внимание, что это усложнит то, что вы пытаетесь сделать.

Также, если у кого-то есть более простой способ написания кода, пожалуйста, дайте мне знать.

1. Избегайте использования Select / Selection et c
2. Использовать автофильтр. Таким образом, петли не потребуются, и вы можете работать с отфильтрованными строками в ONE GO
3. Диапазон констант границы составляет от 5 до 12. Я имею в виду, что значение xlDiagonalDown равно 5 и так далее до xlInsideHorizontal, значение которого равно 12. В таком случае мы можем использовать регистр Loop / Select для форматирования границ / ячеек, как показано ниже

Это то, что вы пытаетесь? Этот код Не проверено . Извините, не смог проверить это, когда я выхожу. Я прокомментировал код, чтобы у вас не было проблем с его пониманием. Но если вы все равно это сделаете, просто спросите.

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long
    Dim rng As Range
    Dim filteredRange As Range
    Dim i As Long

    '~~> Change this to the relevant sheet
    Set ws = Sheet1

    With ws
        '~~> Remove any filters
        .AutoFilterMode = False

        '~~> Find last row in Col Q
        lRow = .Range("Q" & .Rows.Count).End(xlUp).Row

        '~~> Set your range
        Set rng = .Range("Q8:Q" & lRow)

        '~~> Filter the range and set your filtered range
        With rng
            .AutoFilter Field:=1, Criteria1:="=1"
            Set filteredRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With

        '~~> Check if we have any filtered rows
        If Not filteredRange Is Nothing Then
            With filteredRange
                '~~> Change interior color
                With .Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent1
                    .TintAndShade = 0.599993896298105
                    .PatternTintAndShade = 0
                End With

                '~~> Format the borders
                For i = 5 To 12
                    Select Case i
                        '~~> Left, Top, Bottom, Right
                        Case 7 To 10
                            With .Borders(i)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                        '~~> DiagUp,DiagDown,InsideVert,InsideHorz
                        Case 5, 6, 11, 12
                            .Borders(i).LineStyle = xlNone
                    End Select
                Next i
            End With
        End If

        '~~> Remove filters
        .AutoFilterMode = False
    End With
End Sub