Excelループで時間を追加する

Question

これをループするより効率的な方法があります。私は午前7時から午後9時までこれを行う必要があります。 Excelの私は、行に記入し、式は、遅くなることがあるセルの範囲をループ、（2午後7午前）あなたが見てきたよう

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

セルに時間を書き込みます。

する又は同じ値に設定され、あなたが一度に> = 1つのセルの範囲を参照することができるテストするために、.Interiorを含む、いくつかのプロパティを参照する場合。
（注：いないすべての値が同じであれば、参照はNULLを返します）：私は確信して実際に以下のコードことを確認しませんでした

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

だから、あなたのSubはように最適化することができますしかし、それはすべきです。基本的には、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