增加时间的 Excel 循环答案

【问题标题】：Excel Loop which adds time增加时间的 Excel 循环
【发布时间】：2012-01-02 23:20:22
【问题描述】：

有没有更有效的方法来循环这个我需要从早上 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

【问题讨论】：

请向我们展示所需结果的示例。

标签： excel vba loops

【解决方案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

【讨论】：

【解决方案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

【讨论】：