Изменить цвет шрифта на основе даты с помощью VBA в Microsoft Excel
В этой статье мы будем использовать событие книги, чтобы выделить даты, превышающие текущую дату.
Исходные данные для этого примера состоят из дневной цели продаж и достигнутой цели.
Мы хотим выделить дни, которые больше текущей даты.
Логическое объяснение
В этой статье мы создали два макроса: «SetColor» и «ResetColor».
Макрос «SetColor» используется для выделения дат, которые старше текущей даты.
Макрос ResetColor используется для сброса форматирования указанного источника.
Мы использовали два события книги: событие открытия книги и событие перед закрытием книги.
Событие открытия книги запускается при открытии книги. При открытии книги автоматически запускается макрос «SetColor».
Книга перед событием закрытия используется для сброса события, связанного с событием открытия книги.
Объяснение кода
Если IsDate (ActiveCell.Value) и ActiveCell.Value> Date Then Приведенный выше код используется для проверки того, имеет ли значение в ячейке тип данных даты и больше текущей даты.
ActiveCell.Interior.Color = RGB (0, 255, 0)
Приведенный выше код используется для присвоения активной ячейке зеленого цвета.
Установите Source = Range («A1», Range («A1»). SpecialCells (xlCellTypeLastCell))
Приведенный выше код используется для выбора всех данных в таблице Excel.
Пожалуйста, введите код ниже
Option Explicit Sub SetColor() If IsDate(ActiveCell.Value) And ActiveCell.Value > Date Then ActiveCell.Interior.Color = RGB(0, 255, 0) Else ActiveCell.Interior.Color = RGB(221, 235, 247) End If End Sub Sub ResetColor() 'Declaring variables Dim Rng, Source As Range Dim IntRow As Integer, IntCol As Integer 'Specifying all the cells as source range Set Source = Range("A1", Range("A1").SpecialCells(xlCellTypeLastCell)) 'Looping through all the cells For Each Rng In Source 'Checking whether cell contains a value If Not IsEmpty(Rng) Then 'Checking whether cell contain value of date data type If IsDate(Rng.Value) Then Rng.Select 'Assigning Green color if value is greater than today date If DateValue(Rng.Value) > Date Then ActiveCell.Interior.Color = RGB(0, 255, 0) Else ActiveCell.Interior.Color = RGB(221, 235, 247) End If End If End If Next Rng End Sub 'Insert below code in ThisWorkbook module Option Explicit Private Sub Workbook_Open() With Worksheets("Main") 'Event fired on entry to worksheet .OnEntry = "SetColor" 'Event fired on sheet activation .OnSheetActivate = "ResetColor" End With End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) With Worksheets("Main") .OnEntry = "" .OnSheetActivate = "" End With End Sub
Если вам понравился этот блог, поделитесь им с друзьями на Facebook и Facebook.
Мы будем рады услышать от вас, дайте нам знать, как мы можем улучшить нашу работу и сделать ее лучше для вас. Напишите нам на [email protected]