Ошибка приложения при циклическом переключении диапазонов

Question

Я пытаюсь перебрать различные диапазоны, заменяя ячейки значением '1' другим значением / форматом.

Если я использую диапазоны один за другим, это прекрасно работает.Но когда я пытаюсь объединить различные диапазоны и перебрать массив, я получаю определяемую приложением ошибку времени выполнения в части .Pattern.

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

Я уже пробовал:

• код с одним диапазоном без i-петли: код работает
• добавить ActiveSheet в цикл with: С Activesheet.Range (DRng) .cell: fail
• добавить различные способы ссылки на диапазон / лист: fail

• cell.select перед с cell.interior

  Sub SetTelSlot()
  
  
  Dim cell As Range
  Dim DRng(1 To 5) As Range
  Dim i As Long
  
  
  Set DRng(1) = Range("E7:AB33")
  Set DRng(2) = Range("E45:AB71")
  Set DRng(3) = Range("E82:AB108")
  Set DRng(4) = Range("E119:AB145")
  Set DRng(5) = Range("E156:AB182")
  
  
  For i = LBound(DRng) To UBound(DRng)
  
  For Each cell In DRng(i)
      If cell.Value = "1" Then
  
  
  With cell.Interior
          .Pattern = xlSolid        '==>this is giving the error
          .PatternColorIndex = xlAutomatic
          .Color = RGB(0, 204, 153)
          .TintAndShade = 0
          .PatternTintAndShade = 0
      End With
      cell.Font.Bold = SetBold
      cell.Font.Color = vbBlack
      cell.Value = "T"
  
      End If
  
      Next cell
  
  Next i
  
  End Sub
  

Answer 1

В качестве рекомендации: вместо циклического прохождения каждой ячейки в каждом диапазоне вы можете просто создать один объект диапазона, который включает все диапазоны, и искать соответствующие ячейки в этом диапазоне:

Sub SetTelSlot()
    Dim c As Range, DRng As Range
    Dim firstfound As String

    With ActiveSheet
        Set DRng = Union( _
            .Range("E7:AB33"), _
            .Range("E45:AB71"), _
            .Range("E82:AB108"), _
            .Range("E119:AB145"), _
            .Range("E156:AB182") _
        )
    End With
    With DRng
        Set c = .Find("1", LookIn:=xlValues)
        If Not c Is Nothing Then
            firstfound = c.Address
            Do
                ' action
                With c
                    .Font.Bold = SetBold
                    .Font.Color = vbBlack
                    .Value = "T"
                    With .Interior
                        .pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = RGB(0, 204, 153)
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                End With

                ' find next
                Set c = .FindNext(c)
                If c Is Nothing Then
                    Exit Do
                End If
            Loop While c.Address <> firstfound
        End If
    End With
End Sub

Метод FindNext переходит в начало диапазона после достижения его конца; поэтому первый соответствующий адрес сравнивается с завершением цикла.

Answer 2

Файл автоматически сохраняется и защищает, когда я его закрываю. Забыл снять защиту листа. Теперь работает нормально :) 1001 *