Display Excel VBA message box when a cell within a

2019-09-21 15:50发布

I need some help creating the Excel VBA to display a message box when a any input range to a calculated cell (cell with a formula in it) changes and meets a given criterion for the range.

For example, the range "B2" contains calculated cells which are a function of "A2", and if, upon updating the input, "A2", the recalculated cell, "B2" exceeds 20%, I want to warn the user with a message box.

3条回答
Bombasti
2楼-- · 2019-09-21 16:00

Edit: Scott reminded me of the Intersect function which works out nicer than this InRange function

Edit2: This will allow you to have different rules for different ranges. If the cell which was changed by the user is within one of your controlled ranges then the validation rule for that range is called. Otherwise the function goes on.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Range1 As Range, Range2 As Range '...
    Set Range1 = Me.Range("A1:A9")
    Set Range2 = Me.Range("B1:B9")
    '...

    If Not intersect(Range1, Target) Is Nothing Then
        'Rule for Range1
        If Target.Value > 0.2 Then   'put your condition here
            MsgBox "You exceeded 20%"
        End If

    ElseIf intersect(Range2, Target) Is Nothing Then
        'Rule for Range2...
    'elseif more ranges...
         'More rules...
    End If

End Sub
查看更多
Viruses.
3楼-- · 2019-09-21 16:09

Here is an example of using the workbook sheet change event that is checking for a change in the A1 cell in sheet 1

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
    'check to ensure we are working in the correct Sheet
    If ActiveWorkbook.ActiveSheet.Name = "Sheet1" Then
        'check to see how many cells have been targeted
        If Target.Cells.Count = 1 Then
            If Target.Cells.Address = "$A$1" Then
                'check to see what value has been entered into the cell
                If Target.Value = 20 Then
                    MsgBox "Alerting the user"
                End If
            End If
        End If
    End If
End Sub
查看更多
放我归山
4楼-- · 2019-09-21 16:20

UPDATE

This code will only trigger if your input cells change, which is better than just using 'Worksheet_Calulate`:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRange As Range

myRange = Range("B1:B2") '-> assumes input cells are in B1:B2

If Intersect(myRange, Target) Then

    '-> assumes calculated cell in A1
    If Range("A1").Value > 0.2 Then MsgBox "Above 20%"

    '-> to loop through many cells, do this
    Dim cel As Range
    For Each cel In Range("A1:A10")

        If cel.Value > 0.2 Then MsgBox cel.Address & " Above 20%"
        Exit For

    Next

End If

End Sub
查看更多
登录 后发表回答