VBA-根據另一列中的連續日期查找一列中的條件值更改

Question

我是VBA的新手，很難弄清楚如何進行這項工作。 我在嘗試着：

1. 選擇所有等於60的DOWNTIME_CODES
2. 選擇任何跟隨代碼60的DOWNTIME_CODES ，並且DATE_VALUE在代碼60之后是連續的（例如，日期9/3和9/12之間的VAN HOOK 2）。

我一直在嘗試創建一個以DOWNTIME_CODE = 60為起點的宏，然后查看日期以查看其是否連續，即使DOWNTIME_CODE更改為DOWNTIME_CODE或其他值也是如此。 有數百個COMPLETION_NAMES因此我無法手動執行此操作，因此需要能夠遍歷所有COMPLETION_NAMES全。 我嘗試使用IF THEN語句標識代碼60，然后在其中使用另一個IF THEN來檢查DATE_VALUE是否連續，然后將這些結果復制到主表中，然后開始搜索下一個代碼60。可以是一個完成的單獨代碼60，並且可能只有一個

這是我處理過的代碼的版本之一，它是簡化的概念化。 我還不能走得很遠，也找不到類似的東西。 這是我找到的最接近的示例：

• VBA-條件求和B列，直到A列中的值更改並且
• VBA，需要基於另一列中的更改的條件求和

這是我如何解決這個問題的總體思路。

If DOWNTIME_CODE = 60 Then
    If DATE_VALUE = DATE_VALUE.Offset(-1) Then
        cell.Offset(0, 2) = CHECK
    End If
Else
    DOWNTIME_CODE = DOWNTIME_CODE + DOWNTIME_CODE.Offset(0, 1)
End If

示例數據：

在方法或指導方面的任何幫助將不勝感激！ 感謝您抽出寶貴的時間閱讀我的帖子！

Answer 1

試試以下代碼片段：

Dim bOn As Boolean  ' block is on or off
Dim r As Range
Dim rDC As Range    ' range where to look for 60
Dim lBegin As Long, lEnd As Long  ' 1st and last row of the current block
Dim d As Date

Set rDC = Range("j1:j" & ActiveSheet.UsedRange.Rows)

bOn = False         ' no block has begun
For Each r In rDC
    If r.Value = 60 Then
        If Not bOn Then
            lBegin = r.Row      ' remember row where the block begins
            lEnd = 0
            d = r.Offset(0, -2).Value ' save 1st date in block
            bOn = True
        End If
    End If
    If bOn Then
        If r.Offset(1, -2) = d + 1 Then  ' check date in next row
            d = d + 1
        Else        ' end of consecutive dates
            lEnd = r.Row

 ' At this point lBegin and lEnd contains the 1st and last row of a block of consecutive dates

            If lBegin > 0 And lEnd > 0 Then
                Range(Cells(lBegin, "A"), Cells(lEnd, "J")).Copy
            End If
            lBegin = 0
            bOn = False
        End If
    End If
Next r

Answer 2

Private Sub coloring()
    Dim color1 As Variant, color2 As Variant, usingColor As Variant
    color1 = RGB(180, 255, 180) 'Green
    color2 = RGB(255, 255, 150) 'Yellow
    usingColor = color1

    Dim found60 As Boolean: found60 = False
    Dim rng As Range

    For Each rng In Range(Range("J2"), Cells(ActiveSheet.UsedRange.Rows.Count, "J"))
        If found60 Then
            'Checking date is consecutive or not
            If rng.Offset(0, -2).Value - 1 = rng.Offset(-1, -2).Value Then 
                rng.EntireRow.Interior.Color = usingColor
            Else
                found60 = False
                usingColor = IIf(usingColor = color1, color2, color1)
            End If
        End If

        'We haven't found a 60 or the last series is over
        If Not found60 Then
            If rng.Value = 60 Then
                found60 = True
                rng.EntireRow.Interior.Color = usingColor
            End If
        End If
    Next rng
End Sub

邏輯：每次輸入一行時，我們都會首先檢查是否在最后一行找到60。 如果這樣做，請檢查日期。 如果日期是連續的，則為它上色； 如果不是，那么我們找到了該系列的最后日期。 然后回去找到60。

結果：