Question

在给定的图像中，我有项目名称及其开始和结束日期。我想编写一个VBA代码，如果开始日期和结束日期之间的差异小于等于3个月，则结束日期将突出显示为绿色。此外，我希望能够通过使用列标题名称来实现此目的，因为列位置可能在将来更改。因此，我不想使用条件格式，而是使用VBA代码编写基于列标题名称的动态代码。任何帮助表示赞赏。提前谢谢！

Answer 1

如下所示（假设3个月你的意思是90天）：

Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your Sheet above, change Sheet1 as required
Dim FoundStart As Range
Dim FoundEnd As Range
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the number of rows with data from Column A
            Set FoundStart = ws.Rows(1).Find(What:="Start") 'find the header with "Start"
            Set FoundEnd = ws.Rows(1).Find(What:="End") 'find the header with "End"
            If Not FoundStart Is Nothing And Not FoundEnd Is Nothing Then 'if both headers are found then
                For i = 2 To LastRow 'loop from row 2 to last
                    If ws.Cells(i, FoundStart.Column) - ws.Cells(i, FoundEnd.Column) <= 90 Then ' if the difference between start and end is less or equal to 90 days
                        ws.Cells(i, FoundEnd.Column).Interior.ColorIndex = 4 'highlight End in Green
                    End If
                Next i
            Else
                MsgBox "Headers Not found!", vbInformation
            End If
End Sub

<强>更新

如果您要突出显示月份差异为3或更小的行而不是90天，那么这样的事情就可以了：

Sub foo2()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your Sheet above, change Sheet1 as required
Dim FoundStart As Range
Dim FoundEnd As Range
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the number of rows with data from Column A
            Set FoundStart = ws.Rows(1).Find(What:="Start") 'find the header with "Start"
            Set FoundEnd = ws.Rows(1).Find(What:="End") 'find the header with "End"
            If Not FoundStart Is Nothing And Not FoundEnd Is Nothing Then 'if both headers are found then
                For i = 2 To LastRow 'loop from row 2 to last
                    MonthDiff = DateDiff("m", ws.Cells(i, FoundStart.Column), ws.Cells(i, FoundEnd.Column))
                    If MonthDiff <= 3 Then
                        ws.Cells(i, FoundEnd.Column).Interior.ColorIndex = 4 'highlight End in Green
                    End If
                Next i
            Else
                MsgBox "Headers Not found!", vbInformation
            End If
End Sub

使用列标题的VBA代码，没有条件格式

1 个答案: