Как запустить 3 цикла для условного форматирования на нескольких листах

Question

Я пытаюсь условно отформатировать 4 листа с различными диапазонами без использования Select

Я пытаюсь очистить мой очень сумасшедший код для начинающих и ускорить процесс, но циклы не работают. Все пустые ячейки в диапазонах на Рабочих листах 2 и 3 должны быть заполнены буквой «Т». Пустые ячейки в диапазонах на листах 4 и 5 должны быть "p". Все ячейки с данными на листах 2-4 отформатированы одинаково: жирный шрифт, выравнивание по центру, рамка, условно заменить текст, а также шрифт и цвет шрифта в зависимости от текста ячейки.

Sub comfor()

Dim ws As Worksheet, cell As Range

For Each ws In ActiveWorkbook.Sheets
    For i = 2 To 3
        With Sheets(i)
            For Each cell In ws.Range(ws.Range("A6"),_ ws.Range("A6").SpecialCells(xlLastCell)).Cells
                   If Text = "" Then
                   Value = "T"
                End If
            Next
         End With
      Next

    For i = 4 To 5
        With Sheets(i)
            For Each cell In ws.Range(ws.Range("A6"),_ ws.Range("A6").SpecialCells(xlLastCell)).Cells
                 If Text = "Not Recorded" Then
                    Value = "p"
                End If
            Next
        End With
    Next
    For i = 2 To 5
        With Sheets(i)
            For Each cell In ws.Range(ws.Range("A6"),_ ws.Range("A6").SpecialCells(xlLastCell)).Cells
               With cell
                    .HorizontalAlignment = xlCenter
                   .Font.Bold = True
               End With

               With cell
                   .Borders(xlEdgeLeft).Weight = xlMedium
                   .Borders(xlEdgeTop).Weight = xlMedium
                   .Borders(xlEdgeBottom).Weight = xlMedium
                   .Borders(xlEdgeRight).Weight = xlMedium
               End With

               With cell
                    If .Text = "Incomplete" Then
                       .Font.Color = vbRed
                       .Value = "T"
                       .Font.Name = "Wingdings 2"

                    ElseIf .Text = "Not Applicable" Then
                        .Name = "Webdings"
                        .Value = "x"
                        .Font.Color = RGB(255, 192, 0)

                    ElseIf .Text = "Complete" Then
                        .Font.Color = 5287936
                        .Value = "R"
                        .Font.Name = "Wingdings 2"

                    ElseIf .Text = "Not Recorded" Then
                        .Font.Color = RGB(129, 222, 225)
                        .Value = "p"
                        .Font.Name = "Wingdings"

                    End If
                End With
            Next
        End With
    Next
 Next

End Sub

Answer 1

Я обнаружил, что если бы я использовал Select Case и ws Name вместо i и добавил «For Each ws ..» перед каждым Select Case, он работает и работает очень быстро. Возможно, не самый элегантный, но эффективный.

Sub comfor()

Dim daily As Worksheet, mon As Worksheet, per As Worksheet, surf As Worksheet
Dim ws As Worksheet, cell As Range


Set daily = Sheets("Daily")
Set per = Sheets("Personnel")
Set surf = Sheets("Testing")
Set mon = Sheets("Monthly")

For Each ws In ActiveWorkbook.Sheets
 Select Case ws.Name
    Case "Daily", "Monthly"
        For Each cell In ws.Range(("A6"),_ 
ws.Range("A6").SpecialCells(xlLastCell)).Cells
                If cell.Text = "" Then
                   cell.Value = "T"
                    cell.Font.Color = vbRed
                   cell.Value = "T"
                   cell.Font.Name = "Wingdings 2"
                   End If
            Next
    End Select
 Next

For Each ws In ActiveWorkbook.Sheets
 Select Case ws.Name
    Case "Personnel", "Testing"
    For Each cell In ws.Range(("A6"), ws.Range("A6").SpecialCells(xlLastCell)).Cells
             If cell.Text = "" Then
                cell.Value = "p"
                    cell.Font.Color = RGB(255, 192, 0)
                    cell.Value = "p"
                    cell.Font.Name = "Wingdings 3"
                    End If
        Next

    End Select
Next

For Each ws In ActiveWorkbook.Sheets
 Select Case ws.Name
    Case "Daily", "Monthly", "Personnel", "Testing"
        For Each cell In ws.Range(ws.Range("A6"),_ 
ws.Range("A6").SpecialCells(xlLastCell)).Cells
           With cell
                .HorizontalAlignment = xlCenter
           End With

            With cell
             .Borders(xlInsideVertical).Weight = xlThin
             .Borders(xlInsideHorizontal).Weight = xlThin
             .Borders(xlEdgeLeft).Weight = xlMedium
             .Borders(xlEdgeTop).Weight = xlMedium
             .Borders(xlEdgeBottom).Weight = xlMedium
             .Borders(xlEdgeRight).Weight = xlMedium
             End With

                If cell.Text = "Incomplete" Then
                   cell.Font.Color = vbRed
                   cell.Value = "T"
                   cell.Font.Name = "Wingdings 2"

                ElseIf cell.Text = "Not Applicable" Then
                    cell.Name = "Webdings"
                    cell.Value = "x"
                    cell.Font.Color = RGB(255, 192, 0)

                ElseIf cell.Text = "Complete" Then
                     cell.Font.Color = 5287936
                     cell.Value = "R"
                     cell.Font.Name = "Wingdings 2"

                End If

            Next
    End Select
 Next

End Sub

Answer 2

Замените ваши циклы этим вместо этого - цикл не действует так же, как оператор With - вам все равно придется явно ссылаться на cell.Text/cell.Value - ЕСЛИ вы не хотите встроить оператор With внутри ваш цикл - что вы абсолютно могли бы - но даже тогда, это должно быть .Text и .Value.

For i = 2 To 3
        With Sheets(i)
            For Each cell In ws.Range(ws.Range("A6"), ws.Range("A6").SpecialCells(xlLastCell)).Cells
                   If cell.Text = "" Then
                   cell.Value = "T"
                End If
            Next
         End With
      Next

    For i = 4 To 5
        With Sheets(i)
            For Each cell In ws.Range(ws.Range("A6"), ws.Range("A6").SpecialCells(xlLastCell)).Cells
                 If cell.Text = "Not Recorded" Then
                    cell.Value = "p"
                End If
            Next
        End With
    Next