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

ProgramBox

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

Post author:admin
Запись опубликована:22 августа, 2022
Post category:Вопросы по программированию

#vba #loops #formatting #worksheet

#vba #циклы #форматирование #рабочий лист

Вопрос:

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

Я пытаюсь очистить свой очень сумасшедший код для начинающих и ускорить процесс, но циклы не работают. Все пустые ячейки в диапазонах на листах 2 и 3 должны быть заполнены буквой «T». Пустые ячейки в диапазонах на листах 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

1. Извините, я неправильно разместил код. Я нажал отправить, прежде чем исправить это.

2. Что такое Text и Value ? В вашем коде это просто необъявленные переменные. Это должно быть If cell.Value = "" Then и cell.Value = "T" и т. Д.

3. Спасибо. Я изменил «Текст» и «Значение» на «ячейку». Значение», но когда я запускаю код, пустые ячейки на листах не заполняются, и это занимает безумно много времени.

Ответ №1:

Замените свои циклы на this вместо этого — цикл не действует так же, как 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

1. Я заменил то, что у меня было выше, но все равно ничего не происходит.

2. ws.Range("A6").SpecialCells(xlLastCell)).Cells скорее всего, виновник — какой диапазон вы ожидаете, что это вернет?

3. Диапазон для каждого ws отличается. Количество столбцов / ws не изменится, но строки могут зависеть от количества дней в месяце. У всех ws есть заголовок, поэтому я настроил все, чтобы начать форматирование с A6. Изначально я настроил это так, чтобы выбирать каждую страницу, диапазон, а затем форматировать, но я надеялся на более чистый и быстрый способ. Также единственным столбцом, в котором гарантированно не будет пустых ячеек, является столбец даты «A».

4. Я использовал macro recorder и Ctl End, чтобы получить ws.Range(ws.Range(«A6»), ws.Range («A6»)). Специальные ячейки (xlLastCell)). Ячейки.

5. Я заметил, что при наведении курсора мыши на «ячейку» во всплывающем окне отображается «ячейка =» значение в A6 на листе 1! Я не хочу форматировать лист 1, а следующий не переходит на другой лист.

Ответ №2:

Я обнаружил, что если я использую регистр выбора и имя ws вместо i и добавляю «Для каждого ws .. перед каждым регистром выбора, он работает и работает очень быстро. Может быть, не самый элегантный, но эффективный.

 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

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