2012-01-02 80 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