Я новичок в 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, а может быть только один

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

И вот общее представление о том, как я подхожу к проблеме.

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

Пример данных:
Пример данных

Мы будем очень благодарны за любую помощь по подходу или руководство о том, как это сделать! Спасибо, что нашли время прочитать мой пост!

2
Jesse_V 26 Сен 2018 в 03:39

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.

Результат: введите описание изображения здесь

0
newacc2240 26 Сен 2018 в 07:25

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

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
0
AcsErno 26 Сен 2018 в 07:13