Question

我是VBA的新手，无法弄清楚如何进行这项工作。我正在尝试：

选择所有等于60的DOWNTIME_CODES
选择任何跟随代码60的DOWNTIME_CODES，并且DATE_VALUE在60之后是连续的（例如，VAN HOOK 2在日期9/3和9/12之间）。

我一直试图创建一个以DOWNTIME_CODE = 60为起点的宏，然后查看日期以查看其是否连续，即使DOWNTIME_CODE变为70、21管他呢。 COMPLETION_NAMES有几百个，因此我无法手动执行此操作，因此需要能够遍历所有补全。我尝试使用IF THEN语句来标识代码60，然后在其中使用另一个IF THEN来检查DATE_VALUE是否连续，然后将这些结果复制到主表之外，并然后开始搜索下一个代码60。一个完成可以有单独的代码60，并且可能只有一个

这是我处理过的代码的版本之一，它是简化的概念化。我还不能走得很远，也找不到类似的东西。这是我找到的最接近的示例：

这是我如何解决此问题的一般思路。

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。

结果：

VBA-根据另一列中的连续日期查找一列中的条件值更改

2 个答案: