从Worksheet_Calculate（）子创建一个弹出消息框

Question

我在vba中编写了一个弹出消息，以显示一个单元格的值在0到90之间。但是，由于单元格的值基于天数，因此消息框会多次出现x个月之间。例如：如果2019年2月我的单元格值为29，则弹出框应该会出现。当出现到2019年7月时，弹出框现在出现5次，因为从2月到7月有5个月。我需要弹出框只是出现一次，无论我在前一个月之间有多少个月。

Private Sub Worksheet_Calculate()
Dim Target As Range 
Set Target = Range("C49:C90")
Dim found As Boolean
Dim cell As Range

For Each cell In Target.Cells

    If cell.Value > 0 And cell.Value <= 90 Then
        found = True

    Exit For
    End If
Next
    If found = True Then
    MsgBox "There are employees approaching their expiration date!", vbExclamation, "WARNING!"
    End If

End Sub

Answer 1

完全更改新信息的答案。我们不会使用计算，而是检测用户是否更改了B列中的日期（比如说是今天的日期，如果是这样的话，这可以用VBA完成，也许是另一天）。 A列是培训到期日期。 C栏只是A-B，或今天和到期之间的天数。

1）如果用户选择了一个单元格并且用户已更改该单元格（日期）

2）检查右边的单元格（C列）是否在我们的范围内

3）然后检查右边的单元格（C列相同行）0 <＆lt; Cell.Value＆lt; = 90

4）如果它符合那个标准msgBox Pop（我添加了msgBox的哪一行 参考测试，您可以将其取出，但正如您所看到的，您也可以在此处引用员工姓名，或将信息移至某个过期列表，就像其他工作表一样。）

如果这些都不属实，那就什么都不做。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRange As Range
Set myRange = Range("C49:C90")

    'Check if the user has selected only one cell (for a date)
    'AND
    'Check that the calculation is in the range we are watching C49:C90
    If Selection.Count = 1 And Not Intersect(Target.Offset(0, 1), myRange) Is Nothing Then
        'We are assuming the date change is occuring in column B, so that offset to column C is 0,1
        'If the date that will change is not in B adjust accourdingly here
        If Target.Offset(0, 1).Value > 0 And Target.Offset(0, 1).Value <= 90 Then
            MsgBox "There are employees approaching their expiration date! at row:" & Target.Row, vbExclamation, "WARNING!"
        Else ' Do nothing
        End If
    Else 'Do Nothing
    End If

End Sub

以下是我认为您所追求的内容，如果发生变化并进行相应报告，请检查整个范围。这会在稍作修改后报告符合您条件的每一行。

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRange As Range
Dim report As String
Dim myCell As Range

Set myRange = Range("C49:C90")
report = ""


    'Check if the user has selected only one cell (for a date)
    'AND
    'Check that the calculation is in the range we are watching C49:C90
    If Selection.Count = 1 And Not Intersect(Target.Offset(0, 1), myRange) Is Nothing Then
        For Each myCell In myRange
            If myCell.Value > 0 And myCell.Value <= 90 Then
            report = report & "There are employees approaching their expiration date! at row:" & myCell.Row & vbNewLine
            Else ' Do nothing
            End If
        Next
    Else 'Do Nothing
    End If

    If report <> "" Then
        MsgBox report, vbExclamation, "WARNING!"
    Else 'Do Nothing
    End If

End Sub

快乐的编码！