2012-01-02 81 views
0

有没有更有效的方式来循环这个我需要从上午7点到下午9点做到这一点。在Excel我填写行和公式然后在细胞中写入时间(上午7时至下午2点)Excel循环增加了时间

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 
+2

请向我们展示所需结果的示例。 – 2012-01-03 08:47:40

回答

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 
0

我没有确保低于实际的代码作品,但它应该。基本上我所做的就是尽量减少检查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