Цикл Excel, который добавляет время

Question

Есть ли более эффективный способ сделать это, мне нужно сделать это с 7 утра до 9 вечера. В Excel я заполняю строки, а формула записывает в ячейку время (с 7 утра до 2 вечера)

For a = 5 To 22
  If Sheet3.Range("a" & a).Interior.ColorIndex = xlColorIndexNone And Sheet3.Range("b" & a & ":e" & a).Interior.ColorIndex = 46 Then
    Sheet1.Range("C" & a).Cells = "7 a"
    Sheet1.Range("D" & a).Cells = "9 a"
  End If
Next a

For a = 5 To 22
  If Sheet3.Range("a" & a).Interior.ColorIndex = xlColorIndexNone And Sheet3.Range("b" & a & ":f" & a).Interior.ColorIndex = 46 Then
    Sheet1.Range("C" & a).Cells = "7 a"
    Sheet1.Range("D" & a).Cells = "9:30 a"
  End If
Next a

Answer 1

Как вы уже видели, цикл по диапазону ячеек может быть медленным.

При ссылке на некоторые свойства, включая .Interior, для проверки или установки на одинакового значения, вы можете ссылаться на диапазон> = 1 ячеек за один раз.
(Примечание: если не все значения одинаковы, ссылка вернет NULL)

Итак, ваш Sub может быть оптимизирован как:

Sub Demo()
    Dim sh As Worksheet
    Dim rng As Range

    Set sh = Worksheets("Sheet3")
    Set rng = sh.Range("A5:A22")

    If rng.Interior.ColorIndex = xlColorIndexNone And sh.Range("B5:F22").Interior.ColorIndex = 46 Then
        sh.Range("C5:C22") = "7 a"
        sh.Range("D5:D22") = "9:30 a"
    ElseIf rng.Interior.ColorIndex = xlColorIndexNone And sh.Range("B5:E22").Interior.ColorIndex = 46 Then
        sh.Range("C5:C22") = "7 a"
        sh.Range("D5:D22") = "9 a"
    End If
End Sub

Answer 2

Я не был уверен, что приведенный ниже код действительно работает, но он должен.По сути, я минимизировал количество проверок условий Range.Минимизируя количество обращений к свойствам range, я тем самым минимизирую количество вызовов в Excel, что ускоряет процесс.Я также использовал переменные boolean, чтобы VBA не слишком часто ссылалась на объекты.

Sub ColorTimes()

    Dim b9Union As Boolean, b930Union As Boolean, b7Union As Boolean, bContinue As Boolean
    Dim i As Integer
    Dim rColorNone As Range, rColors49BF As Range, rColors49BE As Range
    Dim rLoop As Range, r7A As Range, r9A As Range, r930A As Range
    Dim wks3 As Worksheet

    'Initialize variables
    Set wks3 = Sheet3
    With wks3
        Set rColorNone = .Range("A5:A22")
        Set rColors49BE = .Range("B5:E22")
        Set rColors49BF = .Range("B5:F22")
    End With
    i = -1: bUnion = False

    'Loop through range in column A.
    For Each rLoop In rColorNone
        i = i + 1
        'Check column A first, VBA automatically checks
        'all values in AND statements, so you need to split them up.
        If rLoop.Interior.ColorIndex = xlColorIndexNone Then
            bContinue = True
            'Check first conditions, if true then don't bother checking the next conditions.
            If rColors49BF.Resize(1).Offset(i).Interior.ColorIndex = 46 Then
                Time7A9A r7A, r9A, wks3, b7Union, b930Union, i + 5
                b7Union = True: b930Union = True
                bContinue = False
            End If
            If bContinue Then
                If rColors49BE.Resize(1).Offset(i).Interior.ColorIndex = 46 Then
                    Time7A9A r7A, r9A, wks3, b7Union, b9Union, i + 5
                    b7Union = True: b9Union = True
                End If
            End If
        End If
    Next rLoop

    If Not r7A Is Nothing Then r7A = "7 a"
    If Not r9A Is Nothing Then r9A = "9 a"
    If Not r930A Is Nothing Then r930A = "9:30 a"

End Sub
Private Sub Time7A9A(ByRef r7A As Range, ByRef r9A As Range, ByRef wks As Worksheet _
        , ByVal b7Union As Boolean, b9Union As Boolean, ByVal iRow As Integer)

    If b7Union Then
        Set r7A = Union(r7A, wks.Cells(iRow, 3))
    Else
        Set r7A = wks.Cells(iRow, 3)
    End If

    If b9Union Then
        Set r9A = Union(r9A, wks.Cells(iRow, 4))
    Else
        Set r9A = wks.Cells(iRow, 4)
    End If

End Sub