Вычтите оставшееся время и сравнивайте число в VBA

У меня есть код ниже, который проверяет col K для даты «Sunday» и «Time» и сравнивается с числами в Col M.

Что делает этот код? :

Например, если дата / время в Col K составляет 2/5/2017 18:00:00, это должно быть за вычетом оставшегося оставшегося времени, то есть 0,6 часа на день, чтобы перебраться, с номером в col M. И вычитание сообщения если значение в Col M равно> 1, то оно должно быть подсвечено или если оно меньше 1 после вычитания, то оно должно быть окрашено в красный цвет.

Проблема:

  1. Код не окрашивается красным цветом, если значения в Col M находятся в диапазоне 1,5,1,6,1,7 и т. Д. Только если он превышает> = 2, он начинает окрашиваться в красный цвет. Как я могу это исправить?
  2. В настоящее время для Pass и Fail определены две процедуры. Как мне это сочетать?

    Sub MinusSunday() Dim r, LastRow, RemainingDay As Double LastRow = Range("M:O").Cells(Rows.Count, "A").End(xlUp).Row Application.ScreenUpdating = False For r = 2 To LastRow RemainingDay = 0 If Weekday(Range("K" & r).Value, vbSunday) = 1 Then RemainingDay = Round((24 - Format(TimeValue(Range("K" & r)), "h")) / 24, 1) If InStr(1, Range("O" & r).Text, "Pass", vbTextCompare) > 0 Then If Range("M" & r) - RemainingDay >= 1 Then Range("M" & r).Cells.Font.ColorIndex = 3 Else Range("M" & r).Cells.Font.ColorIndex = 0 End If End If End If Next r For r = 2 To LastRow RemainingDay = 0 If Weekday(Range("K" & r).Value, vbSunday) = 1 Then RemainingDay = Round((24 - Format(TimeValue(Range("K" & r)), "h")) / 24, 1) If InStr(1, Range("O" & r).Text, "Fail", vbTextCompare) > 0 Then If Range("M" & r) - RemainingDay >= 1 Then Range("M" & r).Cells.Font.ColorIndex = 3 Else Range("M" & r).Cells.Font.ColorIndex = 0 End If End If End If Next r End Sub 

Your RemainingDay = Round((24 - Format(TimeValue(Range("K" & r).Value), "h")) / 24, 1) возвращает оставшееся значение дня от 0 до 1 (ваш пример возвращает 0.2 ).

Поэтому при запуске, если значение в столбце M> = 1.3, оно будет окрашивать шрифт в эту ячейку в красном.

У меня есть Select Case с небольшим «трюком», чтобы объединить обе ваши процедуры.

Примечание . Поскольку вы используете RemainingDay для получения значения оставшегося времени дня во фракции (от 0 до 1), вы можете просто использовать:

 RemainingDay = 1 - TimeValue(Range("K" & r).Value) 

(В настоящее время это не выполняется в коде, ожидая обратной связи с ПО).

Чтобы получить RemainingDay в часах, вы можете использовать:

 RemainingDay = 24 * (1 - TimeValue(Range("K" & r).Value)) 

Код

 Option Explicit Sub MinusSunday() Dim r As Long, LastRow As Long, RemainingDay As Double With Worksheets("Latency") LastRow = .Range("M:O").Cells(.Rows.Count, "A").End(xlUp).Row Application.ScreenUpdating = False For r = 2 To LastRow RemainingDay = 0 If Weekday(.Range("K" & r).Value, vbSunday) = 1 Then ' returns the RemainindDay value in part of days (rounded) RemainingDay = Round((24 - Format(TimeValue(.Range("K" & r).Value), "h")) / 24, 1) ' Use Select case "Trick" for both cases Select Case True Case .Range("O" & r).Text Like "Pass", .Range("O" & r).Text Like "Fail" ' ===== Line below Just for DEBUG ===== .Range("L" & r).Value = .Range("M" & r) - RemainingDay If .Range("M" & r) - RemainingDay >= 1 Then .Range("M" & r).Cells.Font.ColorIndex = 3 Else .Range("M" & r).Cells.Font.ColorIndex = 0 End If Case Else ' currently do Nothing, maybe for the future ? End Select End If Next r End With End Sub 

Запуск этого кода возвращает следующий результат (см. Debug, который я добавил в столбце «L»):

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

Interesting Posts

Как изменить размер окна комментариев по умолчанию в Excel?

VBA для сравнения нескольких значений столбцов, а затем заменить на несколько листов

загружать данные excel в базу данных с помощью jsp / servlet

Формула Excel: если ячейка содержит подстроку «this» AND не содержит подстроку, «которая»

Функция не работает, потому что я использую даты?

Скопируйте содержимое DataGridView в excel

Блокировать ячейки Меньше, чем нулевые и пустые ячейки VBA Excel

Есть ли подобная функция в Excel?

Изменить тип данных ячейки в VBA?

Сделать книгу Excel в версии 1.4

Excel VBA: сохранить жирный стержень. Промежуточные метки при копировании. Поворот на новый лист.

Маска поиска по индексу / матчу с несколькими критериями

VBA: Если в Range (X) есть непустые ячейки, продолжайте с кодом. Остальное, переходите к концу

Использование шаблона в функции SUMIF в VBA

Получение «Не удалось найти реализацию шаблона запроса для типа источника ExcelQueryable <T>». " Ошибка

Давайте будем гением компьютера.