從Worksheet_Calculate（）子項創建一個彈出消息框

Question

我已經在vba中編碼了一條彈出消息，以顯示單元格的值何時介於0到90之間。但是，由於該單元格的值基於x個月之間的天數，因此消息框會出現多次。 例如：如果2019年2月，我的單元格值為29，則應顯示一個彈出框。 到2019年7月時，由於從2月到7月有5個月，所以彈出框現在出現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列只是AB，即從今天到到期之間的天數。

1）如果用戶選擇了一個單元格並且用戶已經更改了該單元格（日期）

2）檢查右邊的單元格（C列）是否在我們的范圍內

3）然后檢查右邊的單元格（C列相同的行）是否為0 <Cell.Value <= 90

4）如果符合msgBox Pop的條件（我添加了msgBox所指的要進行測試的行，則可以將其刪除，但是如您所見，您還可以在此處引用一個Employee名稱，或將信息移至到期列表像另一個工作表的地方）。

如果這些都不是真的，那就什么都不做。

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

編碼愉快！