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）以测试或设置为相同的值时，您可以一次性引用一系列＆gt; = 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

Excel循环增加了时间

2 个答案: