VBA - Найти изменяющиеся условные значения в одном столбце на основе последовательных дат в другом столбце

Question

Я новичок в VBA и не могу понять, как это сделать.Я пытаюсь:

1. Выбрать все DOWNTIME_CODES, которые равны 60
2. Выбрать любой DOWNTIME_CODES, который следует коду 60 и где 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 для одного завершения, и возможно иметь только один

Это одна из версий кода, над которой я работал, это упрощенная концептуализация.Я не смог сделать это очень далеко и не могу найти ничего подобного.Это ближайший пример, который я нашел:

• 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

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.

результат:

Answer 2

Попробуйте этот фрагмент:

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