Question

嗨，这是一个简单的问题，我目前有一个简单的VBA宏设置，它从单元格B3：B10000搜索具有精确颜色49407的单元格，如果是，则它将在消息框中显示。程序的这一部分工作正常但是当我尝试添加第二个循环时，它从单元格D3：D10000搜索的日期是在今天的15天之前它不起作用并且它显示了表格中的每个结果。我尝试使用DateAdd并从当前日期中取出15，我已设置为=＆＃34; Now（）＆＃34;。

基本上我的问题如下，如果我做错了，如果是这样，我该怎么纠正呢？还可以将所有消息放入一个消息框而不是一个接一个地弹出多个框吗？

我目前的代码如下：

Sub dateSub()

Dim jobStatus As Boolean
jobStatus = False
Dim currentDate As Date
currentDate = Now()
Dim subDate As Date
subDate = DateAdd("d", -15, currentDate)
Dim jobID As String
Dim dateID As String

For Each ambercell In Range("B3:B10000")
    For Each dateCell In Range("D3:D10000")

    If ambercell.Cells.EntireRow.Interior.Color = 49407 & dateCell.Value < (currentDate - 15) Then
    jobID = ambercell.Text
    dateID = dateCell.Text
    MsgBox ("List of Job ID's that are still amber & are 15 days Overdue: " & jobID & " on " & dateID)
    End If

    Next
Next

End Sub

我打算设置这个简单的宏，然后在将来展开它，以便将所有的Amber单元格移动到一个新工作表中，或者查看我可以用VBA宏做的更多事情

非常感谢您对此计划的任何帮助。

谢谢，

AlmightyThud

Answer 1

试试这个：

Sub dateSub()

Dim jobStatus As Boolean
jobStatus = False
Dim currentDate As Date
currentDate = Now()
Dim subDate As Date
subDate = DateAdd("d", -15, currentDate)
Dim jobID As String
Dim dateID As String

For Each ambercell In Range("B3:B10000")
If ambercell.Cells.EntireRow.Interior.Color = 49407 Then
    'For Each dateCell In Range("D3:D10000")
     If ambercell.offset( ,2).Value < (currentDate - 15) Then
     jobID = ambercell.Value
     dateID = ambercell.offset( ,2).Value      'dateCell.offset( ,2).Value
     MsgBox ("List of Job ID's that are still amber & are 15 days Overdue: " & jobID & " on " & dateID)
     Else
     jobID = ambercell.Value
     dateID = ambercell.offset( ,2).Value      'dateCell.offset( ,2).Value
     MsgBox ("List of Job ID's that are still amber : " & jobID & " on " & dateID)
     End If
    'Next
End If
Next

End Sub

如何从单元格中的日期（VBA）中减去当前日期？

1 个答案: