Блог

Я работаю над проектом, в котором я сравниваю столбец D со столбцом C листа («Серверная часть»), и разница показана в столбце E (в %). Я хотел бы выделить % разницы (столбец E) КРАСНЫМ цветом, где разница меньше -10,00% и больше 10,00%. Затем хотелось бы скопировать эти элементы из столбца B, соответствующего каждой выделенной ячейке, и вставить их в лист («СРЕДСТВО ОБНОВЛЕНИЯ») под ячейкой A7.

Прилагается скриншот для справки

 Sub check_date()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim wsData As Worksheet, Datasht As Worksheet, lRow As Integer


Set wsData = Sheets("UPDATER")
Set Datasht = Sheets("Backend")
lRow = Datasht.Cells(Rows.Count, 13).End(xlUp).Row


wsData.Range("M8:M" amp; lRow).Interior.ColorIndex = xlNone
wsData.Range("M8:M" amp; lRow).FormatConditions.Add Type:=xlExpression, Formula1:="=AND(M8>=EOMONTH(TODAY(),-2) 1,M8<EOMONTH(TODAY(),-1))"
wsData.Range("M8:M" amp; lRow).FormatConditions(wsData.Range("M8:M" amp; lRow).FormatConditions.Count).SetFirstPriority
 With wsData.Range("M8:M" amp; lRow).FormatConditions(1).Interior
 .Color = RGB(255, 255, 0)
 .TintAndShade = 0
 End With
 wsData.Range("M8:M" amp; lRow).FormatConditions(1).StopIfTrue = False
 Range("M8").Select

End Sub
  

Вот что я получил. Это немного радикальное изменение, но я надеюсь, что это действительно то, к чему вы стремитесь.

 Sub formatcondition()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim wsData As Worksheet, Datasht As Worksheet, lRow As Integer, My_Range As Range, i As Integer, iRow As Integer, cell As Variant, RowNum As Long, lRowUpdater As Long

Set wsData = Sheets("UPDATER")
Set Datasht = Sheets("Backend")
lRow = Datasht.Cells(Rows.Count, 5).End(xlUp).Row
lRowUpdater = wsData.Cells(Rows.Count, 1).End(xlUp).Row
RowNum = 8 'setting the first row in the UPDATER sheet


Datasht.Range("E1:E" amp; lRow).Interior.ColorIndex = xlNone 'Reset the color before running
wsData.Range("A8:D" amp; lRowUpdater   8).ClearContents 'clear your updater sheet. Remove if not needed.

For i = 1 To lRow
    On Error GoTo Continue
    If Datasht.Range("E" amp; i).Value < -0.1 Or Datasht.Range("E" amp; i).Value > 0.1 Then 'If greater than or less than
        Datasht.Range("E" amp; i).Interior.ColorIndex = 6 'Change the color of affected cells if you need that
        wsData.Range(wsData.Cells(RowNum, 1), wsData.Cells(RowNum, 4)).Value = _
        Datasht.Range(Datasht.Cells(i, 2), Datasht.Cells(i, 5)).Value 'straight copy the values from the cells as it loops rather than using copy/paste
        wsData.Range(wsData.Cells(RowNum, 2), wsData.Cells(RowNum, 4)).NumberFormat = "0.00%" 'change the number format of outputted cells to percentages (if needed)
        RowNum = RowNum   1 'move to the next row in the output
    End If
Continue:
Resume Nexti
Nexti:
Next i

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub
  

Редактировать:

Для даты добавления года моя версия будет просто дополнять то, что я указал ранее. Вместо этого мы теперь добавляем AND функцию для хранения OR , затем проверяем, является ли YEAR в ячейке текущий год. Если вам нужен только этот год, мы также можем отказаться от инструкции IF, которая проверяла, что если текущий месяц был январем, он включал бы декабрь. Но если это не нужно, то:

=AND(OR(MONTH(NOW())=MONTH(M8),MONTH(NOW())-1=MONTH(M8)),YEAR(M8)=YEAR(NOW()))

Или

=AND(MONTH(M8)>=MONTH(NOW())-1,MONTH(M8)<MONTH(NOW()) 1,YEAR(M8)=YEAR(NOW()))

Оба имеют одинаковую длину и выполняют одно и то же, только по-разному.