如何在excel中連續行上運行單獨的循環vba

Question

我需要根據列的值在不同的行集上運行獨立循環，例如，循環列值爲「星期一」，從第1行到第n個循環，然後是「星期二」從第n + 1到第18個循環，這些循環需要依次連續運行。例如：

Answer 1

您可以使用字典來檢查是否有某一天重複多次。總共有3個嵌套循環：第一個遍歷工作表中的所有行，第二個循環遍歷給定日期的所有行，最後一個循環遍歷列條目。

看起來您對每個單元格中的初始字符串不感興趣（例如「Res01」，「Res02」等），但只是想知道給定日期是否有相同的時間並突出顯示重複的細胞。

此外，由於您只希望在給定的一天內重複，當該日處理開始時，該字典將被清除。字典的關鍵是時間字符串，值是單元格的地址。對於每個單元格，宏將檢查該時間是否已經在字典中。如果它是重複的，並且原始單元格和當前單元格背景顏色都會更改。如果不是，則鍵/值對被存儲並且處理繼續。

我決定改變顯示連續天數重複的背景顏色（綠色/藍色），以便更容易看出差異。

Option Explicit 

Sub HighliteDiffs() 
    Dim sht As Worksheet 
    Set sht = Worksheets("Staff Schedule") 

    Dim r As Integer, c As Integer, clr As Integer: clr = 4 
    Dim curDay As String, val As String, addr As String 

    Dim dict As Object 
    Set dict = CreateObject("Scripting.Dictionary") 

    Dim rng As Range 

    With sht 
    Dim lastRow As Integer, lastCol As Integer 
    lastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row 

    r = 2 
    Do While r <= lastRow 
     If clr = 4 Then 
     clr = 5 
     Else 
     clr = 4 
     End If 
     dict.RemoveAll 
     curDay = Left(Cells(r, "A").Value, 11) 
     Do While curDay = Left(Cells(r, "A").Value, 11) 
     lastCol = .Cells(r, .Columns.Count).End(xlToLeft).Column 
     For c = 3 To lastCol 
      val = Right(.Cells(r, c).Value, 5) 
      If dict.Exists(val) Then 
      addr = dict(val) 
      Set rng = .Cells(Range(addr).Row, Range(addr).Column) 
      rng.Interior.ColorIndex = clr 
      .Cells(r, c).Interior.ColorIndex = clr 
      Else 
      dict(val) = .Cells(r, c).Address 
      End If 
     Next 
     r = r + 1 
     Loop 
    Loop 
    End With 

End Sub